jOVERSION = 3.00dataenvironmentdataenvironmentDataenvironmentLLeft = 186 Top = 401 Width = 520 Height = 200 Name = "Dataenvironment" cursorcursorCursor1DataenvironmentLeft = 13 Top = 20 Width = 90 Height = 90 Alias = "products" BufferModeOverride = 3 Order = "prodnum" Database = ..\data\trackerdb.dbc CursorSource = "products" Name = "Cursor1" cursorcursorCursor2DataenvironmentLeft = 150 Top = 20 Width = 90 Height = 90 Alias = "productcodes" BufferModeOverride = 3 Database = ..\data\trackerdb.dbc CursorSource = "productcodes" ReadOnly = .T. Name = "Cursor2" 31t_form..\libs\t_base.vcxform frmNewProductHeight = 249 Width = 556 DoCreate = .T. AutoCenter = .T. Caption = "New Product" WindowType = 1 cprodnumchar1 = cprodnumchar2 = cprodnumchar3 = cprodnumchar4 = cprodnumchar5 = nprodnumchar6 = 0 Name = "frmNewProduct"  PROCEDURE isunique PARAMETER mvalue, mdelete IF RECCOUNT() = 0 && If database is empty, RETURN .T. && Key value is unique ENDIF && If database is empty,) munique = .T. mrecord = RECNO() && Save current record number IF mdelete && If validating field, mdeleted = SET("DELETED") && Save DELETED setting SET DELETED ON && Turn on DELETED setting DELETE && Delete current record ENDIF && If validating field,) SEEK mvalue && Search index for key value IF FOUND() && If value found in index, munique = .F. && It is not unique ENDIF && If value found in index,) GOTO mrecord && Return to original record IF mdelete && If record was deleted, RECALL && Recall it SET DELETED &mdeleted && Restore prior DELETED setting ENDIF && If record was deleted,) RETURN munique *** End of function Isunique ENDPROC PROCEDURE Init * Build Product Version combo box SELECT ProductCodes.Description; FROM trackerdb!ProductCodes; WHERE ProductCodes.ID = 'ver'; INTO Array thisform.aProductVersion ThisForm.cboVersion.NumberOfElements = ALEN(thisform.aProductVersion) * Build Product Type combo box SELECT ProductCodes.Description; FROM trackerdb!ProductCodes; WHERE ProductCodes.ID = 'typ'; INTO Array thisform.aProductType ThisForm.cboType.NumberOfElements = ALEN(thisform.aProductType) * Build Product Shipment combo box SELECT ProductCodes.Description; FROM trackerdb!ProductCodes; WHERE ProductCodes.ID = 'shp'; INTO Array thisform.aProductShipments ThisForm.cboShipments.NumberOfElements = ALEN(thisform.aProductShipments) * Build Product Users combo box SELECT ProductCodes.Description; FROM trackerdb!ProductCodes; WHERE ProductCodes.ID = 'use'; INTO Array thisform.aProductUsers ThisForm.cboUsers.NumberOfElements = ALEN(thisform.aProductUsers) * Build Product Invoicing combo box SELECT ProductCodes.Description; FROM trackerdb!ProductCodes; WHERE ProductCodes.ID = 'inv'; INTO Array thisform.aProductInvoicing ThisForm.cboInvoicing.NumberOfElements = ALEN(thisform.aProductInvoicing) * Build Invoice Code combo box SELECT ProductCodes.Description; FROM trackerdb!ProductCodes; WHERE ProductCodes.ID = 'cde'; ORDER BY ProductCodes.Description; INTO Array thisform.aInvoiceCode ThisForm.cboInvoiceCode.NumberOfElements = ALEN(thisform.aInvoiceCode) SELECT ProductCodes USE ** TCK 12/31/00 ** Commenting this section of code out because the Product table ** will no longer have company information. ** * Build array for company codes *SELECT Company.co_name, Company.company_id, Company.co_code; * FROM trackerdb!company; * ORDER BY Company.co_name; * INTO ARRAY thisform.aCompanyCode *ThisForm.cboCompanyCode.NumberOfElements = ALEN(thisform.aCompanyCode) *SELECT Company *USE SELECT Products ENDPROC [ BB%U}%v%CrDCRelease can not be left blankNew Product - Releasex BUTHISFORM CMDBUTTONSEDITMODETHISVALUEClick,11!AAA1)By ``%U%%C XC*Product Number must be between 1 and 99999New Product - Product Numberx BUTHISFORM CMDBUTTONSEDITMODETHISVALUEValid,11AA1)`* t%Up%CiNC"Invoice Code can not be left blankNew Product - Invoice Codex BUTHISVALUEValid,1!A1)BArial, 0, 9, 5, 15, 12, 13, 3, 0 Arial, 0, 8, 5, 14, 11, 12, 3, 0 PROCEDURE Click IF ThisForm.cmdButtons.editmode IF EMPTY(this.value) MESSAGEBOX("Release can not be left blank",16,"New Product - Release") RETURN 0 ENDIF ENDIF ENDPROC  frmNewProducttextboxcprodnumchar1 cprodnumchar2 cprodnumchar3 cprodnumchar4 cprodnumchar5 nprodnumchar6 ^aproductversion[1,0] ^aproducttype[1,0] ^aproductshipments[1,0] ^aproductusers[1,0] ^aproductinvoicing[1,0] ^ainvoicecode[1,0] *isunique ^acompanycode[1,0]  t_combobox..\libs\t_base.vcxcombobox cboVersion frmNewProductPColumnCount = (ALEN(thisform.aProductVersion,2)) RowSourceType = 5 RowSource = "thisform.aProductVersion" ControlSource = "products.version" FirstElement = 1 Height = 24 Left = 100 NumberOfElements = 0 StatusBarText = "What version of the item is this?" TabIndex = 1 Top = 12 Width = 135 BoundTo = .T. Name = "cboVersion" PROCEDURE Valid IF EMPTY(this.value) MESSAGEBOX("Version can not be left blank",16,"New Product - Version") RETURN 0 ELSE DO CASE CASE this.value = 'Domestic' thisform.cProdNumChar4 = "D" CASE this.value= 'World' thisform.cProdNumChar4 = "W" CASE this.value= 'Both' thisform.cProdNumChar4 = "B" CASE this.value= 'Does not apply' thisform.cProdNumChar4 = "X" OTHERWISE thisform.cProdNumChar4 = '*' ENDCASE ENDIF ENDPROC  %_ nU%ATCDoes not apply  6% mC:Number of years has to be greater than 0, for less enter 1!New Product - Subscription Lengthx BUTHISFORM CMDBUTTONSEDITMODELISVALID CBOINVOICINGVALUETHISValid,11qAA2B) txtRelease..\libs\t_base.vcx t_textbox frmNewProductt_label..\libs\t_base.vcxlabelT_label1 frmNewProducteCaption = "Version" Height = 16 Left = 10 Top = 16 Width = 60 TabIndex = 15 Name = "T_label1" t_label..\libs\t_base.vcxlabelT_label2 frmNewProductUCaption = "Type" Left = 10 Top = 44 Width = 60 TabIndex = 16 Name = "T_label2" t_label..\libs\t_base.vcxlabelT_label3 frmNewProductZCaption = "Shipments" Left = 10 Top = 71 Width = 60 TabIndex = 17 Name = "T_label3" t_label..\libs\t_base.vcxlabelT_label4 frmNewProductWCaption = "Users" Left = 10 Top = 101 Width = 60 TabIndex = 18 Name = "T_label4" t_label..\libs\t_base.vcxlabelT_label5 frmNewProduct[Caption = "Invoicing" Left = 10 Top = 132 Width = 60 TabIndex = 19 Name = "T_label5" t_label..\libs\t_base.vcxlabelT_label6 frmNewProductsCaption = "Product Description" Height = 16 Left = 43 Top = 164 Width = 108 TabIndex = 20 Name = "T_label6" t_label..\libs\t_base.vcxlabelT_label7 frmNewProduct{Alignment = 1 Caption = "Product cost" Height = 16 Left = 275 Top = 71 Width = 175 TabIndex = 21 Name = "T_label7" t_label..\libs\t_base.vcxlabelT_label8 frmNewProductyAlignment = 1 Caption = "List price" Height = 16 Left = 275 Top = 44 Width = 175 TabIndex = 22 Name = "T_label8" t_label..\libs\t_base.vcxlabelT_label9 frmNewProductAlignment = 1 Caption = "Length of subscription in Years" Height = 16 Left = 275 Top = 16 Width = 175 TabIndex = 23 Name = "T_label9"  t_combobox..\libs\t_base.vcxcombobox cboShipments frmNewProductRowSourceType = 5 RowSource = "thisform.aProductShipments" ControlSource = "products.shipments" Left = 100 StatusBarText = "How often are the shipments?" TabIndex = 3 Top = 69 Width = 135 BoundTo = .T. Name = "cboShipments" PROCEDURE Valid IF EMPTY(this.value) MESSAGEBOX("Shipments can not be left blank",16,"New Product - Shipments") RETURN 0 ELSE DO CASE CASE this.value = 'Single' thisform.cProdNumChar3 = "S" CASE this.value = 'Weekly' thisform.cProdNumChar3 = "W" CASE this.value = 'Monthly' thisform.cProdNumChar3 = "M" CASE this.value = 'Does not apply' thisform.cProdNumChar3 = "X" OTHERWISE thisform.cProdNumChar3 = '*' ENDCASE ENDIF ENDPROC  H%Fi UU%ATCDoes not apply  6% TC*List Price must be between 0 and 99,999.99New Product - List Pricex BUTHISFORM CMDBUTTONSEDITMODELISVALID CBOINVOICINGVALUETHISValid,11qAAA2))iCaption = "Release" Height = 16 Left = 102 Top = 192 Width = 52 TabIndex = 27 Name = "lblRelease"  t_combobox..\libs\t_base.vcxcomboboxcboUsers frmNewProductRowSourceType = 5 RowSource = "thisform.aProductUsers" ControlSource = "products.users" Left = 100 StatusBarText = "How many users are going to use this item?" TabIndex = 4 Top = 99 Width = 135 BoundTo = .T. Name = "cboUsers" PROCEDURE Valid IF EMPTY(this.value) MESSAGEBOX("Users can not be left blank",16,"New Product - Users") RETURN 0 ELSE DO CASE CASE this.value = 'Single user' thisform.cProdNumChar5 = "S" CASE this.value = 'Multi user' thisform.cProdNumChar5 = "N" CASE this.value = 'Does not apply' thisform.cProdNumChar5 = "X" OTHERWISE thisform.cProdNumChar5 = '*' ENDCASE ENDIF ENDPROC c JJP%U%~%CzLC!Description can not be left blankNew Product - Descriptionx BUTHISFORM CMDBUTTONSEDITMODETHISVALUEValid,11!AA1)JComment = "" ControlSource = "products.releasenum" Height = 23 Left = 155 MaxLength = 5 TabIndex = 13 Top = 189 Width = 38 Name = "txtRelease" label t_combobox..\libs\t_base.vcxcombobox cboInvoicing frmNewProductRowSourceType = 5 RowSource = "thisform.aProductInvoicing" ControlSource = "products.invoicetype" Left = 100 StatusBarText = "How often should an invoice be created?" TabIndex = 5 Top = 127 Width = 135 BoundTo = .T. Name = "cboInvoicing" PROCEDURE Valid IF EMPTY(this.value) MESSAGEBOX("Invoicing can not be left blank",16,"New Product - Invoicing") RETURN 0 ELSE DO CASE CASE this.value = 'Single invoice' thisform.cProdNumChar1 = "S" CASE this.value = 'Annual invoice' thisform.cProdNumChar1 = "A" CASE this.value = 'Does not apply' thisform.cProdNumChar1 = "N" OTHERWISE thisform.cProdNumChar1 = '*' ENDCASE ENDIF ENDPROC  %U5%CcHCInvoicing can not be left blankNew Product - Invoicingx B. Hx*" Single invoiceTS" Annual invoiceTA" Does not applyTN2*T*UTHISVALUETHISFORM CPRODNUMCHAR1Valid,1!!!!AB1) t_combobox..\libs\t_base.vcxcomboboxcboType frmNewProductRowSourceType = 5 RowSource = "thisform.aProductType" ControlSource = "products.type" Height = 24 Left = 100 StatusBarText = "What type of product is this?" TabIndex = 2 Top = 40 Width = 135 BoundTo = .T. Name = "cboType" PROCEDURE Valid IF EMPTY(this.value) MESSAGEBOX("Type can not be left blank",16,"New Product - Type") RETURN 0 ELSE DO CASE CASE this.value = 'BT Product' thisform.cProdNumChar2 = "B" CASE this.value = 'Interface' thisform.cProdNumChar2 = "I" CASE this.value = 'Service' thisform.cProdNumChar2 = "S" CASE this.value = 'Does not apply' thisform.cProdNumChar2 = "X" OTHERWISE thisform.cProdNumChar2 = '*' ENDCASE ENDIF ENDPROC ; ""H%UN%CY>CType can not be left blankNew Product - Typex BG HnC  BT ProductTB  InterfaceTI ServiceTS" Does not apply*TX2CT*UTHISVALUETHISFORM CPRODNUMCHAR2Valid,1!!AB1)"t_basictxtbtns..\libs\t_basicbtns.vcx container cmdButtons frmNewProductTop = 222 Left = 3 TabIndex = 14 Name = "cmdButtons" cmdTop.Name = "cmdTop" cmdPrev.Name = "cmdPrev" cmdNext.Name = "cmdNext" cmdEnd.Name = "cmdEnd" cmdFind.Visible = .F. cmdFind.Name = "cmdFind" cmdPrint.Visible = .F. cmdPrint.Name = "cmdPrint" cmdAdd.Default = .T. cmdAdd.Name = "cmdAdd" cmdEdit.Visible = .F. cmdEdit.Name = "cmdEdit" cmdDelete.Visible = .F. cmdDelete.Name = "cmdDelete" cmdExit.Name = "cmdExit"  PROCEDURE Init DODEFAULT() this.haderror = .F. ENDPROC PROCEDURE cmdAdd.Click LOCAL cProdNumc, cFullProductId This.Parent.cmdEdit.visible = !this.parent.editmode IF This.caption <> "\CType can not be left blankNew Product - Typex  TaB%C HCShipments can not be left blankNew Product - Shipmentsx  TaB%C ?@CUsers can not be left blankNew Product - Usersx  TaB%C HCInvoicing can not be left blankNew Product - Invoicingx  TaB%C [XC*Product Number must be between 1 and 99999New Product - Product Numberx  TaB%C LC!Description can not be left blankNew Product - Descriptionx  TaB%C gDCRelease can not be left blankNew Product - Releasex  TaBTC@L #####_0T%C>rhC:Product ID is not unique, Please change the Product numberNew Product - Product Numberx  TaB CTU CPRODNUMCCFULLPRODUCTIDTHISPARENTCMDEDITVISIBLEEDITMODECAPTIONTHISFORM CBOVERSIONVALUESETFOCUSCBOTYPE CBOSHIPMENTSCBOUSERS CBOINVOICINGTXTPRODUCTNUMBERTXTDESCRIPTION TXTRELEASECPRODNUM NPRODNUMCHAR6 CPRODNUMCHAR1 CPRODNUMCHAR2 CPRODNUMCHAR3 CPRODNUMCHAR4 CPRODNUMCHAR5ISUNIQUEPRODUCTSPR_IDT- CUTHISVISIBLEInit, cmdAdd.ClickZ cmdEdit.ClickE13QAAAAQAAAQAAAQAAAQAAAWAAAQAAAQAAAARAAAA212Uq E V) t_textbox..\libs\t_base.vcxtextboxtxtDescription frmNewProductComment = "" ControlSource = "products.description" Height = 23 Left = 155 MaxLength = 50 StatusBarText = "Enter a description for this item." TabIndex = 11 Top = 161 Width = 358 Name = "txtDescription" PROCEDURE Valid IF ThisForm.cmdButtons.editmode IF EMPTY(this.value) MESSAGEBOX("Description can not be left blank",16,"New Product - Description") RETURN 0 ENDIF ENDIF ENDPROC  lblRelease..\libs\t_base.vcxt_labelPROCEDURE Valid IF ThisForm.cmdButtons.editmode IF !BETWEEN(this.value, 1, 99999) MESSAGEBOX("Product Number must be between 1 and 99999",16,"New Product - Product Number") RETURN 0 ENDIF ENDIF ENDPROC  frmNewProducttxtProductNumbertextboxtextbox t_textbox..\libs\t_base.vcxtextboxtxtCost frmNewProductComment = "" ControlSource = "products.cost" Height = 23 Left = 460 StatusBarText = "Enterr B&Ts cost of producing this item." TabIndex = 8 Top = 69 Width = 75 Name = "txtCost"  t_textbox..\libs\t_base.vcxtextbox txtListprice frmNewProductComment = "" ControlSource = "products.listprice" Height = 23 Left = 460 StatusBarText = "Enter List Price of product." TabIndex = 7 Top = 41 Width = 75 Name = "txtListprice" 4PROCEDURE Valid IF ThisForm.cmdButtons.editmode LOCAL lIsValid lIsValid = IIF(ThisForm.cboInvoicing.value = "Does not apply", this.value >= 0, this.value > 0) IF !lIsValid MESSAGEBOX("List Price must be between 0 and 99,999.99",16,"New Product - List Price") RETURN 0 ENDIF ENDIF ENDPROC ControlSource = "thisform.nProdNumChar6" Format = "K" Height = 23 InputMask = "99999" Left = 460 MaxLength = 5 TabIndex = 10 Top = 127 Width = 50 Name = "txtProductNumber" Alignment = 1 BackStyle = 1 Caption = "Product Number" Height = 17 Left = 275 Top = 132 Width = 175 TabIndex = 25 Name = "lblProductNumber"  frmNewProductlblProductNumberlabellabel frmNewProductcboInvoiceCodelabel t_textbox..\libs\t_base.vcxtextbox txtSublength frmNewProductComment = "" ControlSource = "products.sublength" Height = 23 InputMask = "" Left = 460 MaxLength = 2 StatusBarText = "Enter the number of years the subscription will last." TabIndex = 6 Top = 12 Width = 28 Name = "txtSublength" MPROCEDURE Valid IF ThisForm.cmdButtons.editmode LOCAL lIsValid lIsValid = IIF(ThisForm.cboInvoicing.value = "Does not apply", this.value >= 0, this.value > 0) IF !lIsValid MESSAGEBOX("Number of years has to be greater than 0, for less enter 1",16,"New Product - Subscription Length") RETURN 0 ENDIF ENDIF ENDPROC PROCEDURE Valid IF EMPTY(this.value) MESSAGEBOX("Invoice Code can not be left blank",16,"New Product - Invoice Code") RETURN 0 ENDIF ENDPROC RowSourceType = 5 RowSource = "thisform.aInvoiceCode" ControlSource = "products.invcode" Height = 24 Left = 460 StatusBarText = "Enter Invoice product code." TabIndex = 9 Top = 99 Width = 75 BoundTo = .T. Name = "cboInvoiceCode" combobox..\libs\t_base.vcx t_combobox frmNewProductt_label..\libs\t_base.vcx lblInvcode~Alignment = 1 Caption = "Invoice code" Height = 17 Left = 275 Top = 101 Width = 175 TabIndex = 24 Name = "lblInvcode"  %|U&%C[@CUsers can not be left blankNew Product - Usersx B Hp  Single userTS  Multi userTN" Does not applyTX2T*UTHISVALUETHISFORM CPRODNUMCHAR5Valid,1!!AB1)> %%%UQ%CcHCShipments can not be left blankNew Product - Shipmentsx BJ HxF SingleTS WeeklyTW MonthlyTM" Does not apply-TX2FT*UTHISVALUETHISFORM CPRODNUMCHAR3Valid,1!!AC1)%8 %UK%C_DCVersion can not be left blankNew Product - Versionx BD Ht@ DomesticTD WorldTW BothTB" Does not apply'TX2@T*UTHISVALUETHISFORM CPRODNUMCHAR4Valid,1!A!AA1); ""j%Y(yU 4%CN"Ba Ta TCO %jTCDELETEDvG  E %C4 T- # %:SET DELETED &mdeleted  BUMVALUEMDELETEMUNIQUEMRECORDMDELETED">otrackerdb!ProductCodesverTC>otrackerdb!ProductCodestypT C>otrackerdb!ProductCodesshp T C >otrackerdb!ProductCodesuse T C >otrackerdb!ProductCodesinvTCGotrackerdb!ProductCodescdeTCFQFU PRODUCTCODES DESCRIPTION TRACKERDBIDTHISFORMAPRODUCTVERSION CBOVERSIONNUMBEROFELEMENTS APRODUCTTYPECBOTYPEAPRODUCTSHIPMENTS CBOSHIPMENTS APRODUCTUSERSCBOUSERSAPRODUCTINVOICING CBOINVOICING AINVOICECODECBOINVOICECODEPRODUCTSisunique,Init61qAaaAAAAA4wqAq1 )"