Where have I gone wrong

General FreeBASIC programming questions.
Post Reply
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Where have I gone wrong

Post by paul doe »

Gablea wrote:...
Just hope I can integrate the code you both have provided into my app to support the new method :)

Wish me luck :)
Choose one implementation and go with it, since both address the same problem. Either one is fine, so choose the one that's easier for you to understand/integrate.

Good luck then =D
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Where have I gone wrong

Post by grindstone »

Gablea wrote:Wish me luck :)
As much as I can! :-)
Gablea
Posts: 1104
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Re: Where have I gone wrong

Post by Gablea »

Code: Select all

#Macro declareproperty(fieldname, retType)
   #If retType = "s"
      Declare Property fieldname As String 'for reading
      Declare Property fieldname(v As String) 'for writing
   #ElseIf retType = "i"
      Declare Property fieldname As Integer 'for reading
      Declare Property fieldname(v As Integer) 'for writing
   #EndIf
#EndMacro

#Macro MakeProperty(fieldname, start, length, retType)
   #If retType = "s"
      Property tProduct.fieldname As String 'for reading
         Return Mid(this.record, start, length)
      End Property
      
      Property tProduct.fieldname(v As String) 'for writing
         Mid(this.record, start, length) = Left(v + Space(length), length)
      End Property
      
   #ElseIf retType = "i"
      Property tProduct.fieldname As Integer 'for reading
         Return Val(LTrim(Mid(this.record, start, length), Chr(0)))
      End Property
      Property tProduct.fieldname(v As Integer) 'for writing
         Mid(this.record, start, 4) = Right(String(4, Chr(0)) + Str(v), 4)
      End Property
   #EndIf
#EndMacro


Type tProduct
   Dim record As String
     declareproperty(BarcodeNumber, "s")
  declareproperty(posdescription, "s")
  declareproperty(salelocation, "s")
  declareproperty(agerestricted, "i")
  declareproperty(agelimit, "s")
   declareproperty(pricetype, "s")
  declareproperty(retailprice, "s")
  declareproperty(vatcode, "s")
  declareproperty(print_guarantee_message, "i")
  declareproperty(print_guarantee_code, "s")
  declareproperty(displaymessage, "i")
  declareproperty(messagenumber, "s")
  declareproperty(sendtoppr, "i")
  declareproperty(requestserial, "i")
  declareproperty(itemnotallowed, "i")
  declareproperty(itemnotallowed_reason, "s")
  declareproperty(restrict_product_qty, "i")
  declareproperty(product_qty_allowed, "i")
  declareproperty(discount_not_allowed, "i")
  declareproperty(no_refund_allowed, "i")
  declareproperty(ask_for_qty_before_selling, "i")
  declareproperty(healthy_start_voucher_ok, "i")
End Type

MakeProperty(BarcodeNumber,                1,  13, "s")
MakeProperty(posdescription,              14,  30, "s")
MakeProperty(salelocation,                44,   4, "s")
MakeProperty(agerestricted,               48,   4, "i")
MakeProperty(agelimit,                    52,   2, "s")
MakeProperty(pricetype,                   54,   1, "s")
MakeProperty(retailprice,                 55,  10, "s")
MakeProperty(vatcode,                     65,   1, "s")
MakeProperty(print_guarantee_message,     66,   4, "i")
MakeProperty(print_guarantee_code,        70,   6, "s")
MakeProperty(displaymessage,              76,   4, "i")
MakeProperty(messagenumber,               80,   6, "s")
MakeProperty(sendtoppr,                   86,   4, "i")
MakeProperty(requestserial,               90,   4, "i")
MakeProperty(itemnotallowed,              94,   4, "i")
MakeProperty(itemnotallowed_reason,       98, 255, "s")
MakeProperty(restrict_product_qty,       353,   4, "i")
MakeProperty(product_qty_allowed,        357,   4, "i")
MakeProperty(discount_not_allowed,       361,   4, "i")
MakeProperty(no_refund_allowed,          365,   4, "i")
MakeProperty(ask_for_qty_before_selling, 369,   4, "i")
MakeProperty(healthy_start_voucher_ok,   373,   4, "i")

ReDim As tProduct product(0)

'read product list into array
Open "products.dat" For Binary Access Read As #1
Do Until Eof(1) 
   ReDim Preserve product(UBound(product) + 1)
   product(UBound(product)).record = Input(376, #1)
Loop
Close

'change product no. 1
product(1).BarcodeNumber = "12345"
product(1).posdescription = "WHISKY"
product(1).agerestricted = 18

'save product testfile
Open "productsSave.dat" For Output As #1
For x As Integer = 1 To UBound(product)
   Print #1, product(x).record;
Next
Close

'print out product list
For x As Integer = 1 To UBound(product)
   With product(x)
      Print "             BarcodeNumber ";.BarcodeNumber
     Print "            posdescription ";.posdescription
     Print "              salelocation ";.salelocation
     Print "             agerestricted ";.agerestricted
     Print "                  agelimit ";.agelimit
      Print "                 pricetype ";.pricetype
     Print "               retailprice ";.retailprice
     Print "                   vatcode ";.vatcode
     Print "   print_guarantee_message ";.print_guarantee_message
     Print "      print_guarantee_code ";.print_guarantee_code
     Print "            displaymessage ";.displaymessage
     Print "             messagenumber ";.messagenumber
     Print "                 sendtoppr ";.sendtoppr
     Print "             requestserial ";.requestserial
     Print "            itemnotallowed ";.itemnotallowed
     Print "     itemnotallowed_reason ";.itemnotallowed_reason
     Print "      restrict_product_qty ";.restrict_product_qty
     Print "       product_qty_allowed ";.product_qty_allowed
     Print "      discount_not_allowed ";.discount_not_allowed
     Print "         no_refund_allowed ";.no_refund_allowed
     Print "ask_for_qty_before_selling ";.ask_for_qty_before_selling
     Print "  healthy_start_voucher_ok ";.healthy_start_voucher_ok
      Print "--------------------------------------"
      Sleep
   End With
Next

? "OK"
Sleep
ok I have selected this version of the code but can I ask can the declareproperty and MakeProperty fucntions be placed in to a global file (as my system would be using the same interface for all data files

or does each Data table need to have its own #Macro declareproperty(fieldname, retType) etc?
Gablea
Posts: 1104
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Re: Where have I gone wrong

Post by Gablea »

Code: Select all

	Type tUser
   
   Declare Property CashierPassword As String
   Declare Property CashierName As String
   Declare Property CashierNameReceipit As String
   Declare Property ChangePassword As String
   Declare Property RestrictRefund As String
   Declare Property RestrictRefundValue As String
   Declare Property UserCanOverrideLockout As String
   Declare Property useraccesslevel As String
    'these below this line are future update to the NPoS & KeyPoS (AND MAYBE KPoS)
    'DIM DiscountLockout(0) As UByte
    'DIM Discountvalue(9) As UByte
    'DIM OverrideDiscountLock(0) As UByte

Type tCashierData
		Dim DatabaseRecord 									As String
	  	declareproperty(CashierNumber, "s")
	  	declareproperty(CashierPassword, "s")
	  	declareproperty(CashierName, "s")
	  	declareproperty(CashierNameReceipit, "s")
	  	declareproperty(ChangePassword, "i")
	  	declareproperty(RestrictRefund, "i")
	  	declareproperty(RestrictRefundValue, "s")
	  	declareproperty(UserCanOverrideLockout, "i")
	  	declareproperty(UserAccessLevel, "s")
    'these below this line are future update to the NPoS & KeyPoS (AND MAYBE KPoS)
		'declareproperty(DiscountLockout, "i")
		'declareproperty(Discountvalue, "s")
		'declareproperty(OverrideDiscountLock, "i")
End Type

	MakeProperty(CashierNumber, 1,  4, "s")
	MakeProperty(CashierPassword, 5,  4, "s")
	MakeProperty(CashierName, 10,   255, "s")
	MakeProperty(CashierNameReceipit, 266,   40, "i")
	MakeProperty(ChangePassword, 307,   1, "i")
	MakeProperty(RestrictRefund, 309,   1, "i")
	MakeProperty(RestrictRefundValue, 311,   10, "s")
	MakeProperty(UserCanOverrideLockout, 322,   1, "i")
	MakeProperty(UserAccessLevel, 324,   255, "s")

	Public Sub CloseAllFiles
  'close #AgeRefualFileNumber							
  'close #CreditNoteFileNumber							
  'close #CustomerDisplayFileNumber			
	Close #DiscountFileNumber 							
  'close #GuranteeFileNumber	 							
  'close #LotteryFileNumber								
	Close #MultivsaerFileNumber							
	Close #ManDeptFileNumber								
	close #NoSaleReasonFileNumber 						
  'close #PLUMenuFileNumber				
  'close #PLUListFileNumber								
  'close #PayoutReasonFileNumber			 			
  'close #ProductLibaryFileNumber				 		
	close #ProductFileNumber 								
  'close #ProductMessagesFileNumber 					
  'close #QuickTenderFileNumber 						
	close #Recipit_HeadderFileNumber					
	close #Recipit_FotterFileNumber
  'close #RefundReasonsFileNumber						
  'close #SafeSettingsFileNumber					
  'close #ScanningCouponsFileNumber				
	close #CashierDatabaseFileNumber				
	close #VATCodesFileNumber	
	End Sub

	
	
 Public Sub FindCashier (ByVal CashierNumber As String, ByVal CashierPassword As String)
	Dim recordLength			As Integer = 0
	Dim recordNumber			As Integer = 0
	Dim lastRecord				As Integer = 0
	Dim CashierFound 			As Integer = 0
	
	
	recordLength = len(CashierRecord)
	Cls
	
	Print "Path to Database : "; PathToCashierDatabase

	Print "Cashier Number To Find :"; CashierNumber
	Print "Cashier Password : "; CashierPassword
	Print "Database Record Length :"; recordLength
	
	Open PathToCashierDatabase For Random Access Read Write As #CashierDatabaseFileNumber len = recordLength
	
	lastRecord = lof(CashierDatabaseFileNumber) \ recordLength
		Print "lof(CashierDatabaseFileNumber)="; lof(CashierDatabaseFileNumber)
		Print "lastRecord"; lastRecord
		
	For recordNumber = 1 to lastRecord
   	get #CashierDatabaseFileNumber, recordNumber, CashierRecord
  	  	
  		Select Case CashierRecord.CashierNumber
  			Case = cashierNumber Then
  				If CashierRecord.CashierPassword = CashierPassword Then
  					Select Case Trim(CashierRecord.ChangePassword) ' Check to see if Password Needs to be changed
  						Case "0"	' Password Does not need to be changed
									    KeyPadInput = ""
			    	  			  CashierNamePrint = Trim(CashierRecord.CashierNameReceipit)
				        		     CashierAccess = Trim(CashierRecord.useraccesslevel) 	'Set the system to use the signed on cashier 
							CashierOverrideAccess = 0
							   PriceOverridePrice = 0               			'Clears the Entered Price 
					       				 TotalDue = 0 								'Resets sale value
					    				   ItemsSold = 0 								'Resets item count
					     			  TotalTendered = 0								'Resert the total tendered value
					 				   RecipitClear = 1								'Set the recipit so a new one can be produced for sale
					 		    		    SaleMode = "Sale"							'Sets the salemode back to sale
								 'RecallInProgress = "No"							'Resets the Recall trigger so the system will run in normal mode
					  			  ShowTaskBarItems = 1
					 				SubTotalPressed = 0
				         			DisplayLine1 = ""
										DisplayLine2 = ""		
							Salescreen
						
  						Case "1"
						 	KeyPadInput = ""
			  				'PasswordChange1
  					End Select
  				Else
  					updateCashierScreen(CashierDisplayComSettings, "USER PASSWORD DOES", 0, "NOT MATCH. PRESS CLEAR" & KeyPadInPutPassword, 1, 0)
						Do : Dim KeyPress As Long = GetKeyNB
							Select Case KeyPress
								Case Key_Clear
									KeyPadInput = ""
									CloseAllFiles
									RequestCashierPassword(CashierNumber)
								Exit Sub
							End Select
  				End If
			Case <> cashierNumber
				updateCashierScreen(CashierDisplayComSettings, "USER NOT FOUND", 0, "PRESS CLEAR" & KeyPadInPutPassword, 1, 0)
					Do : Dim KeyPress As Long = GetKeyNB
						Select Case KeyPress
							Case Key_Clear
								KeyPadInput = ""
								RequestCashierID
								Exit Sub
						End Select
			End If
  		End Select
	Next	
	
	Close #CashierDatabaseFileNumber

 End Sub

 Public Sub FindProductinDatabase(ByVal BarcodeNumber As String)

	Print BarcodeNumber
	
	If RecipitClear = 1 Then
		CreateRecipitHeadder
		CreateRecipitFooter
		'ResetPoSdataForNewSale
	End If
 
	Dim ProductFound 										As Integer = 0
	
	Do until EOF(ProductFileNumber)
		Input #ProductFileNumber, Product_barcodenumber, Product_posdescription, Product_salelocation, Product_agerestricted, Product_agelimit, Product_pricetype, Product_retailprice, Product_vatcode, Product_print_guarantee_message, Product_print_guarantee_code, Product_DisplayMessage, Product_DisplayMessage_code, Product_sendtoppr, Product_requestserial, Product_ItemNotAllowed, Product_ItemNotAllowedReason, Product_RestrictProductQty, Product_RestrictProductAllowed, Product_DiscountNotAllowed, Product_RefundNotAllowed, Product_AskQtyBeforeSelling, Product_HelhtlyStartVoucherOK

		Print Product_barcodenumber, Product_posdescription
			 
		If Trim(BarcodeNumber) = Trim(Product_barcodenumber) Then
			ProductFound = 1
			CloseAllFiles
			Exit Do
		End If		
	Loop
		
	Select Case ProductFound
		Case 0 ' Nothing Found
			ItemNotFound(BarcodeNumber)
			
		Case 1  'Item was found in data file
			Select Case Product_ItemNotAllowed
				Case 1 'Item is NOT allowed to be sold
					ItemNotallowedScreen
				
				Case 0 'Item is allowed to be sold
  					Dim LocalProduct As String = Product_posdescription
		  
						Product_posdescription = strReplace(LocalProduct, "''", """")
						  	 SaleLocationNumber = Trim(Product_salelocation)
										 PriceType = Trim(Product_pricetype)
										PriceCheck = Val(Trim(Product_retailprice))
									   PriceCheck =(PriceCheck * 100)								
						
					Select Case Product_agerestricted
						Case 0
							'PriceTypeCheck													'Normal Item
								
						Case 1
							'AgeLimitDisplay(Val(Trim(Product_agelimit)))			'Age limited Item		
					End Select
				Exit Sub
			End Select
	End Select
	Exit Sub
End Sub

Error messages
  • C:\FreeBASIC\1.5\fbc -s console "KPoS.bas"
    C:\FreeBASIC\FreeBASIC - Projects\KPoS\database.bi(17) error 237: Fields cannot be named as keywords in TYPE's that contain member functions or in CLASS'es, found 'Type' in 'Type tCashierData'
    C:\FreeBASIC\FreeBASIC - Projects\KPoS\database.bi(20) error 4: Duplicated definition in 'declareproperty(CashierPassword, "s")'
    C:\FreeBASIC\FreeBASIC - Projects\KPoS\database.bi(21) error 4: Duplicated definition in 'declareproperty(CashierName, "s")'
    C:\FreeBASIC\FreeBASIC - Projects\KPoS\database.bi(22) error 4: Duplicated definition in 'declareproperty(CashierNameReceipit, "s")'
    C:\FreeBASIC\FreeBASIC - Projects\KPoS\database.bi(23) error 4: Duplicated definition in 'declareproperty(ChangePassword, "i")'
    C:\FreeBASIC\FreeBASIC - Projects\KPoS\database.bi(24) error 4: Duplicated definition in 'declareproperty(RestrictRefund, "i")'
    C:\FreeBASIC\FreeBASIC - Projects\KPoS\database.bi(25) error 4: Duplicated definition in 'declareproperty(RestrictRefundValue, "s")'
    C:\FreeBASIC\FreeBASIC - Projects\KPoS\database.bi(26) error 4: Duplicated definition in 'declareproperty(UserCanOverrideLockout, "i")'
    C:\FreeBASIC\FreeBASIC - Projects\KPoS\database.bi(27) error 4: Duplicated definition in 'declareproperty(UserAccessLevel, "s")'
    C:\FreeBASIC\FreeBASIC - Projects\KPoS\database.bi(32) error 19: Expected 'END TYPE' or 'END UNION', found 'Type' in 'End Type'
    C:\FreeBASIC\FreeBASIC - Projects\KPoS\database.bi(32) error 132: Too many errors, exiting

    Build error(s)
What have i done wrong?
Gablea
Posts: 1104
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Re: Where have I gone wrong

Post by Gablea »

Code: Select all

#Macro declareproperty(fieldname, retType)
   #If retType = "s"
      Declare Property fieldname As String 'for reading
      Declare Property fieldname(v As String) 'for writing
   #ElseIf retType = "i"
      Declare Property fieldname As Integer 'for reading
      Declare Property fieldname(v As Integer) 'for writing
   #EndIf
#EndMacro

#Macro MakeProperty(fieldname, start, length, retType)
   #If retType = "s"
      Property tProduct.fieldname As String 'for reading
         Return Mid(this.record, start, length)
      End Property
      
      Property tProduct.fieldname(v As String) 'for writing
         Mid(this.record, start, length) = Left(v + Space(length), length)
      End Property
      
   #ElseIf retType = "i"
      Property tProduct.fieldname As Integer 'for reading
         Return Val(LTrim(Mid(this.record, start, length), Chr(0)))
      End Property
      Property tProduct.fieldname(v As Integer) 'for writing
         Mid(this.record, start, 4) = Right(String(4, Chr(0)) + Str(v), 4)
      End Property
   #EndIf
#EndMacro 	
I just found I can not reuse the same MakeProperty for the Cahiere Database then I can for the Product database :( Does that mean I need to declare new MakeProperty* (* = fucntion Name) for each eg

Code: Select all

#Macro MakePropertyCashier(fieldname, start, length, retType)
   #If retType = "s"
      Property tCashier.fieldname As String 'for reading
         Return Mid(this.record, start, length)
      End Property
      
      Property tCashier.fieldname(v As String) 'for writing
         Mid(this.record, start, length) = Left(v + Space(length), length)
      End Property
      
   #ElseIf retType = "i"
      Property tCashier.fieldname As Integer 'for reading
         Return Val(LTrim(Mid(this.record, start, length), Chr(0)))
      End Property
      Property tCashier.fieldname(v As Integer) 'for writing
         Mid(this.record, start, 4) = Right(String(4, Chr(0)) + Str(v), 4)
      End Property
   #EndIf
#EndMacro 
or is there a way i can supplier the t name at runtime? say in the MakeProperty(fieldname, start, length, retType) Line for example

MakeProperty(tName, fieldname, start, length, retType)


please find attached my full KPoS soruce code. (http://www.algpos.co.uk/freebasic/kpos.7z
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Where have I gone wrong

Post by grindstone »

gablea wrote:is there a way i can supplier the t name at runtime? say in the MakeProperty(fieldname, start, length, retType)
Not at runtime, but at compile time.

MakeProperty is not a function, but a macro (and its purpose is to save typing work :-) ). That means, every time you write "MakeProperty(...)" in your source code, it is replaced with the text between #Macro <macroName> and #EndMacro by the compiler. If you want to use the macro for different Types, you can submit the Type name in its parameter list.

Code: Select all

#Macro declareproperty(fieldname, retType)
	#If retType = "s"
		Declare Property fieldname As String 'for reading
		Declare Property fieldname(v As String) 'for writing
	#ElseIf retType = "i"
		Declare Property fieldname As Integer 'for reading
		Declare Property fieldname(v As Integer) 'for writing
	#EndIf
#EndMacro

#Macro MakeProperty(typeName, fieldname, start, length, retType)
	#If retType = "s"
		Property typeName.fieldname As String 'for reading
			Return Mid(this.record, start, length)
		End Property
		
		Property typeName.fieldname(v As String) 'for writing
			Mid(this.record, start, length) = Left(v + String(length, " "), length)
		End Property
		
	#ElseIf retType = "i"
		Property typeName.fieldname As Integer 'for reading
			Return Val(LTrim(Mid(this.record, start, length), Chr(0)))
		End Property
		Property typeName.fieldname(v As Integer) 'for writing
			Mid(this.record, start, 4) = Right(String(4, Chr(0)) + Str(v), 4)
		End Property
	#EndIf
#EndMacro

Type tUser
	Dim record As String
	
	declareproperty(CashierPassword, "s")
	declareproperty(CashierName, "s")
	declareproperty(CashierNameReceipit, "s")
	declareproperty(ChangePassword, "s")
	declareproperty(RestrictRefund, "s")
	declareproperty(RestrictRefundValue, "s")
	declareproperty(UserCanOverrideLockout, "s")
	declareproperty(useraccesslevel, "s")
		
End Type

MakeProperty(tUser, CashierPassword,          1,   4, "s")
MakeProperty(tUser, CashierName,              5, 255, "s")
MakeProperty(tUser, CashierNameReceipit,    260,  40, "s")
MakeProperty(tUser, ChangePassword,         300,   1, "s")
MakeProperty(tUser, RestrictRefund,         301,   1, "s")
MakeProperty(tUser, RestrictRefundValue,    302,  10, "s")
MakeProperty(tUser, UserCanOverrideLockout, 312,   1, "s")
MakeProperty(tUser, useraccesslevel,        313, 255, "s")

ReDim As tUser user(0)

'read user list into array
Open "users.dat" For Binary Access Read As #1
Do Until Eof(1) 
	ReDim Preserve user(UBound(user) + 1)
	user(UBound(user)).record = Input(571, #1)
Loop
Close

'print out user list
For x As Integer = 1 To UBound(user)
	With user(x)
		Print "        CashierPassword ";.CashierPassword
		Print "            CashierName ";.CashierName
		Print "    CashierNameReceipit ";.CashierNameReceipit
		Print "         ChangePassword ";.CashierNameReceipit
		Print "         RestrictRefund ";.RestrictRefund
		Print "    RestrictRefundValue ";.RestrictRefundValue
		Print " UserCanOverrideLockout ";.UserCanOverrideLockout
		Print "        useraccesslevel ";.useraccesslevel
		Print "---------------------------------------------"
		Sleep
	End With
Next

? "OK"
Sleep
Try this analogue for the cashier database. If you don't get along with it, please post an example like for "user" and "product" and I'll (try to) write it for you.

Edit: My 7z can't unpack the KPoS archive ('unsupported compression method')
Gablea
Posts: 1104
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Re: Where have I gone wrong

Post by Gablea »

http://www.algpos.co.uk/freebasic/kpos.zip

Hopefully grindstone you should be able to unzip this zip file if not I will upload the folder to my ftp and send you a pvt message with a user name and password
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Where have I gone wrong

Post by grindstone »

Unpacked successfully . Thank you.
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Where have I gone wrong

Post by paul doe »

@Gablea: you need to pay attention and read the FreeBasic Manual entry on #macro. You changed the definition of the type to this:

Code: Select all

Type tCashierData
  Dim DatabaseRecord 									As String
  /'
    ...
  '/ 
End Type
Yet the macro definition for 'MakeProperty' is this:

Code: Select all

#Macro MakeProperty(tName, fieldname, start, length, retType)
   #If retType = "s"
      Property tName.fieldname As String 'for reading
         Return Mid(this.record, start, length)
      End Property
      
      Property tName.fieldname(v As String) 'for writing
         Mid(this.record, start, length) = Left(v + Space(length), length)
      End Property
      
   #ElseIf retType = "i"
      Property tName.fieldname As Integer 'for reading
         Return Val(LTrim(Mid(this.record, start, length), Chr(0)))
      End Property
      
      Property tProduct.fieldname(v As Integer) 'for writing
         Mid(this.record, start, 4) = Right(String(4, Chr(0)) + Str(v), 4)
      End Property
   #EndIf
#EndMacro 	
Which means that the macro is trying to create a property with a member that doesn't exists (this.record, that you renamed to DatabaseRecord).
This is the corrected version:

Code: Select all

#Macro declareproperty(fieldname, retType)
   #If retType = "s"
      Declare Property fieldname As String 'for reading
      Declare Property fieldname(v As String) 'for writing
   #ElseIf retType = "i"
      Declare Property fieldname As Integer 'for reading
      Declare Property fieldname(v As Integer) 'for writing
   #EndIf
#EndMacro

'#Macro MakeProperty(fieldname, start, length, retType)
#Macro MakeProperty(tName, fieldname, start, length, retType)
   #If retType = "s"
      Property tName.fieldname As String 'for reading
         Return Mid(this.databaserecord, start, length)
      End Property
      
      Property tName.fieldname(v As String) 'for writing
         Mid(this.databaserecord, start, length) = Left(v + Space(length), length)
      End Property
      
   #ElseIf retType = "i"
      Property tName.fieldname As Integer 'for reading
         Return Val(LTrim(Mid(this.databaserecord, start, length), Chr(0)))
      End Property
      
      Property tName.fieldname(v As Integer) 'for writing
         Mid(this.databaserecord, start, 4) = Right(String(4, Chr(0)) + Str(v), 4)
      End Property
   #EndIf
#EndMacro 	

Type tCashierData
		Dim DatabaseRecord 									As String
	  	declareproperty(CashierNumber, "s")
	  	declareproperty(CashierPassword, "s")
	  	declareproperty(CashierName, "s")
	  	declareproperty(CashierNameReceipit, "s")
	  	declareproperty(ChangePassword, "i")
	  	declareproperty(RestrictRefund, "i")
	  	declareproperty(RestrictRefundValue, "s")
	  	declareproperty(UserCanOverrideLockout, "i")
	  	declareproperty(UserAccessLevel, "s")
    'these below this line are future update to the NPoS & KeyPoS (AND MAYBE KPoS)
		'declareproperty(DiscountLockout, "i")
		'declareproperty(Discountvalue, "s")
		'declareproperty(OverrideDiscountLock, "i")
End Type

MakeProperty(tCashierData, CashierNumber, 1,  4, "s")
MakeProperty(tCashierData, CashierPassword, 5,  4, "s")
MakeProperty(tCashierData, CashierName, 10,   255, "s")
MakeProperty(tCashierData, CashierNameReceipit, 266,   40, "s")
MakeProperty(tCashierData, ChangePassword, 307,   1, "i")
MakeProperty(tCashierData, RestrictRefund, 309,   1, "i")
MakeProperty(tCashierData, RestrictRefundValue, 311,   10, "s")
MakeProperty(tCashierData, UserCanOverrideLockout, 322,   1, "i")
MakeProperty(tCashierData, UserAccessLevel, 324,   255, "s")
With these changes the code still doesn't compile, but at least it was 'integrated' successfully. Now you need to modify the 'FindCashier()' function.
Last edited by paul doe on Sep 22, 2018 22:04, edited 1 time in total.
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Where have I gone wrong

Post by grindstone »

I had a brief look at it. The first 2 bugs I found:

- In Type tCashierData you have to rename CashierRecord with record
- In the macro definition you forgot to rename the last tProduct

Happy working, I'll go to sleep now. :-)
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Where have I gone wrong

Post by dodicat »

To circumvent the problem of using a udt to store values from products.dat and rewrite back to a new .dat file, use a string array.
This keeps memory size intact and rewrites properly.

Perhaps it might be easier to edit values and save, but this code is bare bones display and re save.

Code: Select all

 
 

Sub inita(a() As String,record As String,n As Long)
    Dim As Long t
    a(n,1)= Mid(record,1,13)                     :t+=14
    a(n,2)= Mid(record,t,30)                     :t+=30 
    a(n,3)= Mid(record,t,4)                      :t+=4
    a(n,4)= Mid(record,t,4)                      :t+=4 
    a(n,5)= Mid(record,t,2)                      :t+=2
    a(n,6)= Mid(record,t,1)                      :t+=1
    a(n,7)= Mid(record,t,10)                     :t+=10
    a(n,8)= Mid(record,t,1)                      :t+=1
    a(n,9)= Mid(record,t,4)                      :t+=4
    a(n,10)=Mid(record,t,6)                      :t+=6
    a(n,11)=Mid(record,t,4)                      :t+=4
    a(n,12)=Mid(record,t,6)                      :t+=6
    a(n,13)=Mid(record,t,4)                      :t+=4
    a(n,14)=Mid(record,t,4)                      :t+=4
    a(n,15)=Mid(record,t,4)                      :t+=4
    a(n,16)=Mid(record,t,255)                    :t+=255
    a(n,17)=Mid(record,t,4)                      :t+=4
    a(n,18)=Mid(record,t,4)                      :t+=4
    a(n,19)=Mid(record,t,4)                      :t+=4
    a(n,20)=Mid(record,t,4)                      :t+=4
    a(n,21)=Mid(record,t,4)                      :t+=4
    a(n,22)=Mid(record,t,4)                      :t+=4
End Sub

Sub showproducts(a() As String)
    For x As Integer = Lbound(a,1) To Ubound(a,1)
        print "press a key to move forward, escape to exit and save"
        print
        print "                 Record ";x;"   of   "; Ubound(a,1)
        print
        Print "             BarcodeNumber ";a(x,1)
        Print "            posdescription ";a(x,2)
        Print "              salelocation ";a(x,3)
        Print "             agerestricted ";val(a(x,4))
        Print "                  agelimit ";a(x,5)
        Print "                 pricetype ";a(x,6)
        Print "               retailprice ";a(x,7)
        Print "                   vatcode ";a(x,8)
        Print "   print_guarantee_message ";val(a(x,9))
        Print "      print_guarantee_code ";a(x,10)
        Print "            displaymessage ";val(a(x,11))
        Print "             messagenumber ";a(x,12)
        Print "                 sendtoppr ";val(a(x,13))
        Print "             requestserial ";val(a(x,14))
        Print "            itemnotallowed ";val(a(x,15))
        Print "     itemnotallowed_reason ";(a(x,16))
        Print "      restrict_product_qty ";val(a(x,17))
        Print "       product_qty_allowed ";val(a(x,18))
        Print "      discount_not_allowed ";val(a(x,19))
        Print "         no_refund_allowed ";val(a(x,20))
        Print "ask_for_qty_before_selling ";val(a(x,21))
        Print "  healthy_start_voucher_ok ";val(a(x,22))
        
        Print "--------------------------------------"
        Sleep
        If Inkey=Chr(27) Then Exit Sub
    Next
    
End Sub

#Include "file.bi"


Sub savefile Overload(filename As String,p As String)
    Dim As Integer n=Freefile
    If Open (filename For Binary  As #n)=0 Then
        Put #n,,p
        Close
    Else
        Print "Unable to save " + filename
    End If
End Sub

Sub savefile(filename As String,p() As String)
    dim as string t
    For n As Long=Lbound(p,1) To Ubound(p,1)
            For m As Long=1 To 22
                t+=p(n,m)
            Next
        Next
    savefile(filename,t)
End Sub


Sub readfile(filename as string,s() As String)
    Dim As Long f=Freefile,ctr
    Open filename For Binary Access Read As #f
    Dim As String    record
    Do Until Eof(f) 
        ctr+=1
        Redim Preserve s(1 To Ubound(s,1) + 1,1 To 22)
         record = Input(376, #f)
        inita(s(),record,ctr)
    Loop
    Close #f
End Sub


Redim  As String  a(0,1 To 22)

readfile("products.dat", a())
showproducts a()
print "saving... please wait"
if fileexists("newproducts.dat") then Kill "newproducts.dat"

savefile("newproducts.dat",a())


Print "lenght original "; Filelen("products.dat")
Print "length saved    "; Filelen("newproducts.dat")

? "OK"
Sleep

 
 
Gablea
Posts: 1104
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Re: Where have I gone wrong

Post by Gablea »

@paul doe
I did not even Know FreeBASIC did macros until like 3 hours ago when I was reading this code (so this is all new and confusing to me)
and I think my problem at the moment is i am trying to mix vb functions (like tName.Record) with in FreeBASIC

@Dodicat
With your code if I just wanted to read the file would I just use your code up to the point where it Writes the file? (as the file
comes from the Server) for now I just want to work on reading from the file (I will work on saving to the record at some point latter)

@grindstone
I am glad you could unzip it now (not sure why you could not unzip the first one) I'm still working on integrating one of the code versions into my app
but I am still not sure what one to use (going to try both and see what one i feel comfortable with)
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Where have I gone wrong

Post by dodicat »

Gablea.
So you edit the file from the server?

The vbnet udt cannot easily be made into an fb udt.
OK for displaying perhaps via a udt, but it is difficult to get the right size returned for re saving with fixed length strings.
Even with zstrings, and changing chr(0) to chr(255) and back I was not successful.
So I took the simple option of string array.
The option is there to edit this array of course.
but carry on.
Gablea
Posts: 1104
Joined: Apr 06, 2010 0:05
Location: Northampton, United Kingdom
Contact:

Re: Where have I gone wrong

Post by Gablea »

dodicat wrote:Gablea.
So you edit the file from the server?

The vbnet udt cannot easily be made into an fb udt.
OK for displaying perhaps via a udt, but it is difficult to get the right size returned for re saving with fixed length strings.
Even with zstrings, and changing chr(0) to chr(255) and back I was not successful.
So I took the simple option of string array.
The option is there to edit this array of course.
but carry on.

The File is downloaded from the Server and run on the local Machine.

There is data that is sent back to the Windows back office system but this is just sale information and journal data (not even got to that point yet)

If I have to use a tab format or even a CSV formatted data to send the data to the back office i'm open to ideas but I am kind of liking the idea of reading in the data from the windows machine and then saving it locally into a clean data file that the system can work with

I am still trying to think what interface is best for me (and I would need the code to run on DOS as well so for now MySQL Support is out unless someone really smart has worked out how to work with and connect to a MySQL database in DOS)

I have update the KPoS Zip file on the server with my changes that i have tried but i still think i am not getting this fully
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Where have I gone wrong

Post by grindstone »

@ Gablea:

One question: What kind of (network-) connection is there between the tills and the server? If the connection is fast enough I would strongly recommend to work with one file on the server. In this case you only had to implement some kind of message queue. If every till had its own data file it would be pretty hard to keep them synchronized.
Post Reply