home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World Komputer 1998 April B
/
Pcwk4b98.iso
/
Borland
/
Dbase50w
/
SAMPLES1.PAK
/
ORDERS.WFM
< prev
next >
Wrap
Text File
|
1994-08-02
|
27KB
|
814 lines
*******************************************************************************
* PROGRAM: Orders.wfm
*
* WRITTEN BY: Borland Samples Group
*
* DATE: 1/94
*
* UPDATED: 7/94
*
* REVISION: $Revision: 1.86 $
*
* VERSION: dBASE FOR WINDOWS 5.0
*
* DESCRIPTION: This form displays information about an order from a company.
* It allows traversing through orders and going to the top and
* bottom. This form also has a corresponding menu, OrdCust.mnu,
* which allows adding,deleting and searching for an order.
* When an unknown customer number is entered, a dialog will come
* up asking you if you want to add a new customer. If you
* selecte the Yes button, the Customer form (in customer.wfm)
* will be opened, so a new customer can be added.
*
* PARAMETERS: None
*
* CALLS: Orders.mnu (Menu file)
* Buttons.cc (Custom controls file)
* Customer.wfm (Form for displaying customer information)
* Orders.qbe (View of tables)
*
* USAGE: DO Orders.wfm && Note that you can also DO Customer.wfm
*
*******************************************************************************
#include <Messdlg.h>
shell(.f.,.t.)
create session
set talk off
set ldCheck off && To avoid language driver conflicts
** END HEADER -- do not remove this line*
* Generated on 07/07/94
*
local f
f = NEW ORDERSFORM()
f.Open()
CLASS ORDERSFORM OF FORM
Set Procedure To BUTTONS.CC additive
this.HelpFile = ""
this.Top = 0.00
this.MenuFile = "ORDERS.MNU"
this.MousePointer = 1
this.View = "ORDERS.QBE"
this.Left = 3.40
this.Maximize = .F.
this.HelpId = ""
this.Text = "Orders -- View Mode"
this.Minimize = .F.
this.Height = 20.80
this.Width = 92.65
this.OnClose = CLASS::ONCLOSE
this.EscExit = .f.
DEFINE RECTANGLE ORDERCUSTRECT OF THIS;
PROPERTY;
Top 0.35,;
Left 0.85,;
Text "Order Info",;
Height 2.74,;
Border .T.,;
Width 75.65,;
ColorNormal "W"
DEFINE RECTANGLE PAYMENTRECT OF THIS;
PROPERTY;
Top 10.57,;
Left 0.85,;
Text "Totals",;
Height 6.06,;
Border .T.,;
Width 34.00,;
ColorNormal "W"
DEFINE RECTANGLE SHIPRECT OF THIS;
PROPERTY;
Top 16.82,;
Left 0.85,;
Text "Ship Info",;
Height 3.44,;
Border .T.,;
Width 75.65,;
ColorNormal "W"
DEFINE TEXT ORDERNOTEXT OF THIS;
PROPERTY;
Top 1.24,;
Alignment 5,;
Left 2.55,;
Text "Order No:",;
Height 1.25,;
Border .F.,;
Width 11.05,;
ColorNormal "B/W"
DEFINE ENTRYFIELD ORDERNOENTRY OF THIS;
PROPERTY;
Top 1.19,;
OnChange CLASS::CHANGESMADE,;
Left 14.45,;
Enabled .F.,;
DataLink "ORDERS->ORDER_NO",;
Height 1.19,;
Border .T.,;
Width 6.80,;
ColorNormal "N/W"
DEFINE TEXT CUSTOMERNOTEXT OF THIS;
PROPERTY;
Top 1.24,;
Alignment 5,;
Left 25.50,;
Text "Customer No:",;
Height 1.25,;
Border .F.,;
Width 13.09,;
ColorNormal "B/W"
DEFINE ENTRYFIELD CUSTOMERNOENTRY OF THIS;
PROPERTY;
Top 1.19,;
OnChange CLASS::CHANGESMADE,;
Left 39.10,;
Enabled .F.,;
DataLink "ORDERS->CUSTOMER_N",;
Height 1.19,;
Border .T.,;
Width 5.95,;
ColorNormal "N/W"
DEFINE TEXT SALEDATETEXT OF THIS;
PROPERTY;
Top 1.24,;
Alignment 5,;
Left 46.75,;
Text "&Sale Date:",;
Height 1.25,;
Border .F.,;
Width 12.75,;
ColorNormal "B/W"
DEFINE SPINBOX SALEDATESPIN OF THIS;
PROPERTY;
Top 1.19,;
OnChange CLASS::CHANGESMADE,;
Left 61.20,;
Enabled .F.,;
DataLink "ORDERS->SALE_DATE",;
Height 1.19,;
Border .T.,;
Width 13.60,;
ColorNormal "N/W",;
Rangemax 100,;
Rangemin 0.00
DEFINE RECTANGLE LINEITEMSRECT OF THIS;
PROPERTY;
Top 3.38,;
Left 0.85,;
Text "&Line Items",;
Height 7.07,;
Border .T.,;
Width 75.65,;
ColorNormal "N/W"
DEFINE BROWSE CHILDBROWSE OF THIS;
PROPERTY;
Append .F.,;
ShowRecNo .F.,;
OnNavigate CLASS::BrowseOnNavigate,;
Top 4.45,;
Alias "Lineitem",;
FontBold .F.,;
OnChange CLASS::BROWSECHANGESMADE,;
Fields "STOCK_NO\13,QTY\14,SELL_PRICE\16,TOTAL = SELL_PRICE*QTY\16",;
Left 1.70,;
ShowDeleted .F.,;
Delete .F.,;
Height 5.40,;
Width 73.95,;
ColorNormal "B/W",;
Modify .F.
DEFINE TEXT TOTINVTEXT OF THIS;
PROPERTY;
Top 11.62,;
Alignment 8,;
Left 1.70,;
Text "Total Invoice:",;
Height 1.07,;
Border .F.,;
Width 13.60,;
ColorNormal "B/W"
DEFINE ENTRYFIELD TOTINVENTRY OF THIS;
PROPERTY;
Top 11.62,;
Left 17.00,;
Enabled .F.,;
DataLink "ORDERS->TOTAL",;
Height 1.01,;
Border .T.,;
Picture "9,999,999.99",;
Width 17.00,;
ColorNormal "N/W",;
Function "J"
DEFINE TEXT TOTPAIDTEXT OF THIS;
PROPERTY;
Top 13.13,;
Alignment 8,;
Left 1.70,;
Text "A&mount Paid:",;
Height 1.01,;
Border .F.,;
Width 13.09,;
ColorNormal "B/W"
DEFINE ENTRYFIELD AMTPAIDENTRY OF THIS;
PROPERTY;
Top 13.13,;
Left 17.00,;
DataLink "ORDERS->AMT_PAID",;
Height 1.01,;
Border .T.,;
Picture "9,999,999.99",;
Width 17.00,;
ColorNormal "N/W",;
Enabled .F.,;
OnChange CLASS::AMTPAIDONCHANGE,;
Function "J"
DEFINE TEXT BALDUETEXT OF THIS;
PROPERTY;
Top 14.65,;
Alignment 8,;
Left 1.70,;
Text "Balance Due:",;
Height 1.01,;
Border .F.,;
Width 13.09,;
ColorNormal "B/W"
DEFINE ENTRYFIELD BALDUEENTRY OF THIS;
PROPERTY;
Value 0.00,;
Top 14.65,;
Left 17.00,;
Height 1.01,;
Border .T.,;
Picture "9,999,999.99",;
Width 17.00,;
ColorNormal "N/W",;
Enabled .F.,;
Function "J"
DEFINE RECTANGLE TERMSRECT OF THIS;
PROPERTY;
Top 10.57,;
Left 35.70,;
Text "&Terms",;
Height 6.06,;
Border .T.,;
Width 16.15,;
ColorNormal "W"
DEFINE RADIOBUTTON TERMSFOB OF THIS;
PROPERTY;
Top 11.23,;
Group .T.,;
OnChange CLASS::CHANGESMADE,;
Left 37.40,;
Enabled .F.,;
DataLink "TERMS",;
Text "FOB",;
Height 1.25,;
Width 12.75,;
ColorNormal "N/W"
DEFINE RADIOBUTTON TERMSNET30 OF THIS;
PROPERTY;
Top 12.30,;
Group .F.,;
OnChange CLASS::CHANGESMADE,;
Left 37.40,;
Enabled .F.,;
DataLink "TERMS",;
Text "Net 30",;
Height 1.25,;
Width 12.75,;
ColorNormal "N/W"
DEFINE RECTANGLE PAYMETHODRECT OF THIS;
PROPERTY;
Top 10.61,;
Left 52.70,;
Text "Pa&yment Method",;
Height 6.06,;
Border .T.,;
Width 23.80,;
ColorNormal "W"
DEFINE RADIOBUTTON PAYCHECK OF THIS;
PROPERTY;
Top 11.40,;
Group .T.,;
OnChange CLASS::CHANGESMADE,;
Left 54.40,;
ID 1,;
Enabled .F.,;
DataLink "PAY_METHOD",;
Text "Check",;
Height 1.01,;
Width 12.75,;
ColorNormal "N/W"
DEFINE RADIOBUTTON PAYCREDIT OF THIS;
PROPERTY;
Top 12.47,;
Group .F.,;
OnChange CLASS::CHANGESMADE,;
Left 54.40,;
ID 1,;
Enabled .F.,;
DataLink "PAY_METHOD",;
Text "Credit",;
Height 0.66,;
Width 12.75,;
ColorNormal "N/W"
DEFINE RADIOBUTTON PAYMC OF THIS;
PROPERTY;
Top 13.36,;
Group .F.,;
OnChange CLASS::CHANGESMADE,;
Left 54.40,;
Enabled .F.,;
DataLink "PAY_METHOD",;
Text "MC",;
Height 0.78,;
Width 12.75,;
ColorNormal "N/W"
DEFINE RADIOBUTTON PAYCASH OF THIS;
PROPERTY;
Top 14.32,;
Group .F.,;
OnChange CLASS::CHANGESMADE,;
Left 54.40,;
Enabled .F.,;
DataLink "PAY_METHOD",;
Text "Cash",;
Height 1.01,;
Width 12.75,;
ColorNormal "n/w"
DEFINE RADIOBUTTON PAYVISA OF THIS;
PROPERTY;
Top 15.33,;
Group .F.,;
OnChange CLASS::CHANGESMADE,;
Left 54.40,;
Enabled .F.,;
DataLink "PAY_METHOD",;
Text "Visa",;
Height 1.01,;
Width 11.05,;
ColorNormal "N/W"
DEFINE TEXT SHIPDATETEXT OF THIS;
PROPERTY;
Top 17.77,;
Alignment 5,;
Left 1.87,;
Text "S&hip Date:",;
Height 0.72,;
Border .F.,;
Width 12.75,;
ColorNormal "B/W"
DEFINE SPINBOX SHIPDATESPIN OF THIS;
PROPERTY;
Top 17.35,;
OnChange CLASS::CHANGESMADE,;
Left 17.00,;
Enabled .F.,;
DataLink "ORDERS->SHIP_DATE",;
Height 1.19,;
Border .T.,;
Width 17.34,;
ColorNormal "N/W",;
Rangemax 100,;
Rangemin 0.00
DEFINE TEXT SHIPVIATEXT OF THIS;
PROPERTY;
Top 18.84,;
Alignment 5,;
Left 3.40,;
Text "Ship &Via:",;
Height 1.25,;
Border .F.,;
Width 11.39,;
ColorNormal "B/W"
DEFINE RADIOBUTTON SHIPDHL OF THIS;
PROPERTY;
Top 19.19,;
Group .T.,;
OnChange CLASS::CHANGESMADE,;
Left 17.85,;
Enabled .F.,;
DataLink "SHIP_VIA",;
Text "DHL",;
Height 0.81,;
Width 10.20,;
ColorNormal "N/W"
DEFINE RADIOBUTTON SHIPEMERY OF THIS;
PROPERTY;
Top 19.19,;
Group .F.,;
OnChange CLASS::CHANGESMADE,;
Left 28.90,;
Enabled .F.,;
DataLink "SHIP_VIA",;
Text "Emery",;
Height 0.81,;
Width 10.20,;
ColorNormal "N/W"
DEFINE RADIOBUTTON SHIPFEDEX OF THIS;
PROPERTY;
Top 19.19,;
Group .F.,;
OnChange CLASS::CHANGESMADE,;
Left 39.10,;
Enabled .F.,;
DataLink "SHIP_VIA",;
Text "FedEx",;
Height 0.81,;
Width 10.20,;
ColorNormal "N/W"
DEFINE RADIOBUTTON SHIPUPS OF THIS;
PROPERTY;
Top 19.19,;
Group .F.,;
OnChange CLASS::CHANGESMADE,;
Left 50.15,;
Enabled .F.,;
DataLink "SHIP_VIA",;
Text "UPS",;
Height 0.81,;
Width 10.20,;
ColorNormal "N/W"
DEFINE RADIOBUTTON SHIPUSMAIL OF THIS;
PROPERTY;
Top 19.19,;
Group .F.,;
OnChange CLASS::CHANGESMADE,;
Left 61.20,;
Enabled .F.,;
DataLink "SHIP_VIA",;
Text "US Mail",;
Height 0.81,;
Width 12.75,;
ColorNormal "N/W"
DEFINE PREVBUTTON PREVORDERBUTTON OF THIS;
PROPERTY;
Top 0.80,;
Group .T.,;
OnClick CLASS::PREVIOUS,;
Left 77.35,;
Height 1.50,;
Width 14.11
DEFINE NEXTBUTTON NEXTORDERBUTTON OF THIS;
PROPERTY;
Top 3.15,;
Group .F.,;
OnClick CLASS::NEXT,;
Left 77.35,;
Default .T.,;
Height 1.50,;
Width 14.11
DEFINE PUSHBUTTON FIRSTORDERBUTTON OF THIS;
PROPERTY;
Top 5.23,;
Group .F.,;
OnClick {;form.CheckCommit(form.inEditMode);go top},;
Left 77.35,;
Text "F&irst",;
Height 1.50,;
Width 14.11,;
ColorNormal ""
DEFINE PUSHBUTTON LASTORDERBUTTON OF THIS;
PROPERTY;
Top 7.42,;
Group .F.,;
OnClick {;form.CheckCommit(form.inEditMode);go bottom},;
Left 77.35,;
Text "L&ast",;
Height 1.50,;
Width 14.11,;
ColorNormal ""
DEFINE IMAGE LOGOIMAGE OF THIS;
PROPERTY;
Top 17.35,;
Alignment 1,;
Left 77.35,;
Height 2.85,;
Width 15.30,;
DataSource "FILENAME DIVESHOP.BMP"
****************************************************************************
procedure Open
****************************************************************************
private orderNoField
if type("form.init") = "U"
form.init = .t.
set skip to && orders.qbe contains set skip to lineitem
set exact off && the .qbe file contains SET EXACT ON
set procedure to Sampproc additive
set procedure to Customer.wfm additive
form.inEditMode = .f. && indicator of view/edit state
form.changesMade = .f. && indicator of changes made to field values
form.previousRecord = .f. && Save record number when appending
*** do calculations in another area so form doesn't get updated
use orders again in select() alias temp
select temp
orderNoField = field(1) && order_no field
set order to &orderNoField && order_no -- tag name is same as field
go bottom
form.maxOrder = &orderNoField && max value for key field -- for creating
&& new orders
use in temp
select orders
***
*** Open table for calculating totals and balance due in another work area
*** so that datalinks are not affected by record movements
use lineitem again in select() alias lineitem2 order tag order_no
select orders
set relation to order_no into lineitem2 constrain integrity additive
***
if type("form.parentCustomerForm") <> "U"
form.EscExit = .t.
endif
endif
form.BrowseOnNavigate() && calculate totals
form::open() && Now the form actually opens
****************************************************************************
procedure OnClose
****************************************************************************
if form.inEditMode
form.ViewEdit()
endif
if type("form.parentCustomerForm") = "U" && If called from Customer, leave shell(.f.)
shell(.t.)
close procedure SampProc
close procedure Customer.wfm
close procedure Orders.mnu
endif
****************************************************************************
procedure BrowseOnNavigate
****************************************************************************
* calculate total invoice and balance
if eof()
form.root.order.viewEdit.enabled = .f.
else
form.root.order.viewEdit.enabled = .t.
form.balDueEntry.value = orders->total - form.AmtPaidEntry.value
show object form.balDueEntry
endif
form.CallShowCustomer()
****************************************************************************
procedure ChangesMade
****************************************************************************
form.changesMade = .t.
****************************************************************************
procedure BrowseChangesMade
****************************************************************************
local t
form.changesMade = .t.
go recno("LINEITEM") in lineitem && Make sure change is posted
select lineitem2 && recalculate totals in other workarea
calculate sum(lineitem2->sell_price * lineitem2->qty) to t
select orders
replace orders->total with t
form.balDueEntry.value = orders->total - orders->amt_paid
****************************************************************************
procedure AmtPaidOnChange
****************************************************************************
form.changesMade = .t.
form.BrowseOnNavigate() && calculate totals
****************************************************************************
procedure Next
****************************************************************************
form.CheckCommit(form.inEditMode)
if .not. eof()
NEXTBUTTON::OnClick()
endif
****************************************************************************
procedure Previous
****************************************************************************
form.CheckCommit(form.inEditMode)
PREVBUTTON::OnClick()
****************************************************************************
procedure CheckCommit (newInEditMode)
****************************************************************************
private orderField, changesMade
changesMade = form.changesMade
if form.changesMade
orderField = field(1) && Field Order_no
if ConfirmationMessage("Commit changes?",;
FormatStr("Order %1",&orderField)) = YES
commit()
else
rollback()
if .not. empty(form.previousRecord)
go form.previousRecord
form.previousRecord = .f.
endif
endif
if form.inEditMode .and. newInEditMode
begintrans()
endif
form.changesMade = .f.
endif
if form.inEditMode <> newInEditMode
if newInEditMode && Going to Edit mode
begintrans()
else && Going to View mode
if .not. changesMade
rollback()
endif
endif
form.inEditMode = newInEditMode
endif
****************************************************************************
procedure ViewEdit
****************************************************************************
local inEditMode, control, editMenu
editMenu = form.root.order.viewEdit
*** If editing is completed, close transaction, otherwise open a transaction
if form.inEditMode && Change to View mode
form.checkChanged(.f.)
editMenu.text = "&Edit"
editMenu.shortcut = "Ctrl-E"
editMenu.statusMessage = "Edit data."
form.root.order.delete.enabled = .f. && disabled in view mode
form.CheckCommit(.f.) && Check transaction and
form.text = "Orders -- View Mode" && change mode to View
form.childBrowse.modify = .f.
form.statusMessage = "Select Order - Edit menu choice to " +;
"edit/delete data."
else && Change to Edit mode
editMenu.text = "&View"
editMenu.shortcut = "Ctrl-E"
editMenu.statusMessage = "View data."
form.root.order.delete.enabled = .t. && enabled in edit mode
form.CheckCommit(.t.) && Check transaction and
form.text = "Orders -- Edit Mode" && change mode to Edit
form.childBrowse.modify = .t.
form.statusMessage = "In Edit Mode. " +;
"Select Order - View menu choice to switch " +;
"to View mode."
endif
form.childBrowse.setFocus()
control = form.first
inEditMode = form.inEditMode && so don't have to reference many times
do
do case
case control.name $ "ORDERNOENTRY,CUSTOMERNOENTRY,TOTINVENTRY,BALDUEENTRY"
* these are never editable
control.enabled = .f.
case .not. control.className $ "BROWSE,NEXTBUTTON,PREVBUTTON,PUSHBUTTON,IMAGE,TEXT"
* doesn't make sense to make the above classes enabled/not
control.enabled = inEditMode
case control.className = "BROWSE"
control.Modify = inEditMode
control.Delete = inEditMode
control.Append = inEditMode
endcase
control = control.before
until control.name = form.first.name
form.CustomerNoEntry.enabled = .f. && Key field is always disabled
form.OrderNoEntry.enabled = .f. && Key field is always disabled
form.setFocus()
****************************************************************************
procedure CheckChanged(callCommit)
* Check if changes have been made to the current entryfield. This procedure
* is called from menu routines to make sure the form.changesMade gets
* updated when a menu is selected while the changed control has focus.
****************************************************************************
private control, fieldValue
if form.inEditMode
control = form.activeControl
fieldValue = iif(type("control.datalink") <> "U", control.datalink, .f.)
if control.classname = "ENTRYFIELD" .and. type("fieldValue") <> "L" ;
.and. control.value <> &fieldValue
form.changesMade = .t.
endif
endif
if form.changesMade .and. callCommit
form.CheckCommit(form.inEditMode) && Check transactions
endif
****************************************************************************
procedure StartCustomerForm
* Starts the Customer form in it's own session. Note that control returns
* to the current session when this procedure is returned from. This means
* that between the create session command and return you cannot access
* tables in the current session.
****************************************************************************
local custNo
custNo = orders->customer_n && Pass customer_n into into
&& customer form in the new session
create session
set talk off && Set these for the new session
set ldCheck off
form.childCustomerForm = new CustomerForm() && Use Customer.wfm to view
&& or edit a customer
form.childCustomerForm.top = 2.02
form.childCustomerForm.left = 4.25
form.childCustomerForm.customer_n = custNo
form.childCustomerForm.parentOrdersForm = form && Store a reference to this
&& form so that Orders can
&& call events in this form
form.childCustomerForm.open()
****************************************************************************
procedure CallShowCustomer
* Synchronizes the Customer form to the same customer. This is done when
* Orders is run first (form.parentCustomerForm is undefined), and the
* Customer form has been opened (form.childCustomerForm is defined).
****************************************************************************
if type("form.parentCustomerForm") = "U" && Orders is the parent form
if type ("form.childCustomerForm") <> "U" && Customer form defined
form.childCustomerForm.ShowCustomer(orders->customer_n)
endif
endif
****************************************************************************
procedure ShowOrders(custNo, orderNo)
* Called by Customer.wfm when it is the first form run. Used to synchronize
* this form to the same customer for a given order displayed in Customer.
****************************************************************************
private pCustNo
form.CheckChanged(.t.)
set order to custord && Order is customer_n + order_no
pCustNo = custNo && Parameters are local so cannot macro
form.customer_n = custNo && For adding new orders
set key to "&pCustNo" && Only see corresponding orders
go top
seek custNo+orderNo
ENDCLASS