��

VERSION =   3.00
)MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0

cmdclose
Pixels
Close button
Class

1

commandbutton
cmdclose
!Arial, 0, 9, 5, 15, 12, 13, 3, 0

tbrbackcolor

5

j��� 
Q
Q
��
%�
��U�T�9��
�a��T�9���C�������^��'��C�	ForeColorC�
�
�
�^�9����+��C�	BackColor�9���LABEL�9����T�9��
�-��U
ACTIVEFORM
LOCKSCREEN	BACKCOLORSETALLClick,��1

�
q�

2


)Q


���� 
�
�
��
%%
D
4
�U�T�9��
�a��T�9���C�
�
���^��/��C�	ForeColorC�������^�LABEL�9����+��C�	BackColor�9���LABEL�9����2��C�	ForeColorC�������^�CHECKBOX�9����T�9��
�-��U
ACTIVEFORM
LOCKSCREEN	BACKCOLORSETALLClick,��1

�
��!

2
`

)�

vcr
3PROCEDURE Click
IF TYPE("THISFORM.Parent") = "O"
	THISFORMSET.Release
ELSE
	THISFORM.Release
ENDIF
ENDPROC
PROCEDURE Error
LPARAMETERS nError, cMethod, nLine
LOCAL lnChoice
#DEFINE CR CHR(13)
DO CASE
	CASE nError = 1545 && Uncommitted changes
	*------------------------------------
		#DEFINE MSG1_LOC "Do you want to save your changes?"
		#DEFINE MSG2_LOC "Uncommitted Changes"
		lnChoice = MESSAGEBOX(MSG1_LOC, 4+48+0, MSG2_LOC)
		DO CASE
			CASE lnChoice = 6 && yes
				=TABLEUPDATE(.T., .T.)
			CASE lnChoice = 7 && no
				=TABLEREVERT(.T.)
		ENDCASE
		OTHERWISE  && Unanticipated error
	*--------------------------------------	
		#DEFINE NUM_LOC "Error Number: "
		#DEFINE PROG_LOC "Program: "
		#DEFINE CAP_LOC "ERROR"
		lcMsg = NUM_LOC + ALLTRIM(STR(nError)) + CR + CR + ;
				MESSAGE()+ CR + CR + PROG_LOC + PROGRAM(1)
		lnChoice = MESSAGEBOX(lcMsg, 2+48+512, CAP_LOC)
		DO CASE
			CASE lnChoice = 3 &&Abort
				CANCEL
			CASE lnChoice = 4 &&Retry
				RETRY
			CASE lnChoice = 5 &&Ignore
				RETURN
		ENDCASE
ENDCASE

ENDPROC


commandbutton
Pixels
Class
toolbar
tbrbackcolor
cmdWhite

1

j��� 
Q
Q
��
%�
��U�T�9��
�a��T�9���C�
���
�^��'��C�	ForeColorC�
�
�
�^�9����+��C�	BackColor�9���LABEL�9����T�9��
�-��U
ACTIVEFORM
LOCKSCREEN	BACKCOLORSETALLClick,��1

�
q�

2


)Q


PROCEDURE Click
_SCREEN.ActiveForm.LockScreen = .T.
_SCREEN.ActiveForm.BackColor = RGB(255,255,255)
_SCREEN.ActiveForm.SetAll("ForeColor", RGB(0,0,0))
_SCREEN.ActiveForm.SetAll("BackColor", _SCREEN.ActiveForm.BackColor, "LABEL")
_SCREEN.ActiveForm.LockScreen = .F.

ENDPROC

xTop = 6
Left = 75
Height = 23
Width = 24
Picture = menus\white.bmp
Caption = ""
Default = .F.
Name = "cmdWhite"

tbrbackcolor

commandbutton

commandbutton

kPROCEDURE Click
_SCREEN.ActiveForm.LockScreen = .T.
_SCREEN.ActiveForm.BackColor = RGB(0,0,255)
_SCREEN.ActiveForm.SetAll("ForeColor", RGB(255,255,255), "LABEL")
_SCREEN.ActiveForm.SetAll("BackColor", _SCREEN.ActiveForm.BackColor, "LABEL")
_SCREEN.ActiveForm.SetAll("ForeColor", RGB(255,255,255), "CHECKBOX")
_SCREEN.ActiveForm.LockScreen = .F.

ENDPROC

tbrbackcolor
cmdBlue
cmdGreen

formmargin
Pixels
Class
shape

formmargin
VTop = 64
Left = 0
Height = 253
Width = 10
BackColor = 255,0,255
Name = "Shape5"

shape

���� 
�
�
��
%%
D
4
�U�T�9��
�a��T�9���C���
�
�^��/��C�	ForeColorC�������^�LABEL�9����+��C�	BackColor�9���LABEL�9����2��C�	ForeColorC�������^�CHECKBOX�9����T�9��
�-��U
ACTIVEFORM
LOCKSCREEN	BACKCOLORSETALLClick,��1

�
��!

2
`

)�

vTop = 6
Left = 52
Height = 23
Width = 24
Picture = menus\blue.bmp
Caption = ""
Default = .F.
Name = "cmdBlue"


commandbutton

commandbutton
���� 
��D
%Pga�UT��
�-��UTHISVISIBLEDestroy,��1�1
%
)�

commandbutton
cmdPrior

commandbutton

commandbutton
cmdNext
vcr

commandbutton

commandbutton
vcr
tbrbackcolor

commandbutton

commandbutton
tbrbackcolor
cmdRed
�Height = 23
Width = 72
FontBold = .F.
FontName = "MS Sans Serif"
FontSize = 8
Cancel = .T.
Caption = "Close"
Name = "cmdclose"


PROCEDURE Click
_SCREEN.ActiveForm.LockScreen = .T.
_SCREEN.ActiveForm.BackColor = RGB(0,255,0)
_SCREEN.ActiveForm.SetAll("ForeColor", RGB(0,0,0))
_SCREEN.ActiveForm.SetAll("BackColor", _SCREEN.ActiveForm.BackColor, "LABEL")
_SCREEN.ActiveForm.LockScreen = .F.

ENDPROC

xTop = 6
Left = 29
Height = 23
Width = 24
Picture = menus\green.bmp
Caption = ""
Default = .F.
Name = "cmdGreen"


1
!Arial, 0, 9, 5, 15, 12, 21, 3, 0

behindscenes
Pixels
Class

1

commandbutton
behindscenes
pPROCEDURE Click
IF THISFORM.HelpContextID > 0
	HELP ID (THISFORM.HelpContextID)
ELSE
	HELP
ENDIF
ENDPROC


1
	cmdBottom
datachecker
solution.vcx
custom
Datachecker1
vcr
vcr
	container
Class
next.bmp

6

kPROCEDURE Click
_SCREEN.ActiveForm.LockScreen = .T.
_SCREEN.ActiveForm.BackColor = RGB(255,0,0)
_SCREEN.ActiveForm.SetAll("ForeColor", RGB(255,255,255), "LABEL")
_SCREEN.ActiveForm.SetAll("BackColor", _SCREEN.ActiveForm.BackColor, "LABEL")
_SCREEN.ActiveForm.SetAll("ForeColor", RGB(255,255,255), "CHECKBOX")
_SCREEN.ActiveForm.LockScreen = .F.

ENDPROC

sTop = 6
Left = 6
Height = 23
Width = 24
Picture = menus\red.bmp
Caption = ""
Default = .F.
Name = "cmdRed"


commandbutton

commandbutton
�Top = 0
Left = 26
Height = 24
Width = 26
FontBold = .T.
FontName = "Courier New"
FontSize = 11
Caption = "<"
TabIndex = 2
ToolTipText = "Prior"
Name = "cmdPrior"

generic vcr buttons
0PROCEDURE Destroy
THIS.Visible = .F.
ENDPROC

rCaption = "Form BackColor"
Height = 32
Left = 0
Top = 0
Width = 103
ControlBox = .F.
Name = "tbrbackcolor"

toolbar
JArial, 0, 9, 5, 15, 12, 21, 3, 0
MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0

frmsolution
Pixels
Class

7
form
frmsolution
9Top = 165
Left = 265
TabIndex = 4
Name = "Cmdclose1"

frmsolution
	Cmdclose1

commandbutton
solution.vcx
cmdclose
�FontName = "MS Sans Serif"
FontSize = 8
Caption = "Instructions"
Height = 15
Left = 16
Top = 5
Width = 62
TabIndex = 0
Name = "Label4"

frmsolution
Label4
label
label
�FontName = "MS Sans Serif"
FontSize = 8
WordWrap = .T.
Caption = "Sample instructions"
Height = 30
Left = 24
Top = 24
Width = 300
TabIndex = 0
Name = "Label1"

frmsolution
Label1
label
label
bTop = 12
Left = 12
Height = 48
Width = 324
BackStyle = 0
SpecialEffect = 0
Name = "Shape2"

frmsolution
Shape2
shape
shape
;Top = 165
Left = 9
TabIndex = 3
Name = "Behindscenes1"

frmsolution

Behindscenes1

commandbutton
solution.vcx
behindscenes
YTop = 125
Left = 309
Height = 18
Width = 25
centerform = .F.
Name = "C_solutions1"

frmsolution
C_solutions1
custom
solution.vcx
c_solutions
(lsetffcpath
csavesetpath
*addtopath 

�DataSession = 2
Height = 197
Width = 348
DoCreate = .T.
AutoCenter = .T.
Caption = "Solutions"
MaxButton = .F.
HelpContextID = 35
csavesetpath = 
Name = "frmsolution"

form
c_solutions
`cpoint
csep
cdate
ccurrency
cdirectory
ctalk
coldhelp
chelpfile
cdeleted
getdirectory

Pixels
%common solutions sample functionality
Class

1
custom
c_solutions
custom

commandbutton
DTop = 6
Left = 44
Height = 15
Width = 23
Name = "Datachecker1"

(Courier New, 1, 11, 9, 17, 12, 11, 5, 0

Pixels
vcr

���� 
�
�
��%
@
	.
�U.4��
����C��
������UNERRORCMETHODNLINETHISPARENTERROR/
���
��#6�
���
��
���
��UTHISPARENTBEFORERECORDPOINTERMOVEDENABLEDISABLEBUTTONSRECORDPOINTERMOVEDError,��Click���1��
2�R��1
]
y�)�

/Height = 15
Width = 23
Name = "datachecker"

	resizable
Class
custom
	resizable
custom
�skiptable The table to move the record pointer in .
enabledisableoninit
*recordpointermoved Method called each time the record pointer is moved, basically providing a new event for the class.
*enabledisablebuttons 
*beforerecordpointermoved 

next.bmp
Pixels
vcr
datachecker
�Top = 0
Left = 0
Height = 24
Width = 26
FontBold = .T.
FontName = "Courier New"
FontSize = 11
Caption = "|<"
TabIndex = 1
ToolTipText = "Top"
Name = "cmdTop"


commandbutton

�initialresize Is this the first time the controls are being adjusted?
initialformheight
initialformwidth
repositionlist
resizelist
*adjustcontrols call from resize event of a form to adjust the placement and size of contained objects.
*addtoarray 
*setsize 
*loopthroughcontrols 
*reset Resets the Timer control so that it starts counting from 0.
^acontrolstats[1,5] 
*setposition 


qHeight = 19
Width = 27
initialresize = .T.
initialformheight = 0
initialformwidth = 0
repositionlist = Commandbutton Combobox Checkbox Listbox Form Grid Textbox Label Shape Editbox Olecontrol Pageframe Image Spinner
resizelist = Commandbutton Combobox Checkbox Listbox Form Grid Textbox Label Shape Editbox Olecontrol Pageframe Image Spinner
Name = "resizable"

zinitialresize
initialformheight
initialformwidth
addtoarray
setsize
loopthroughcontrols
acontrolstats
setposition


�*handlerecord compares the current value, old value, and original value of each field, displaying a messagebox if a change or conflict is detected.
*string returns type 'c' equivalent of passed value
*verifychanges Prompts a user to save all changes made to a table or record.
*verifyeachchange Prompts a user to confirm each change he or she made.
*checkconflicts Notifies a user if someone else has changed the data in the table after he or she began editing a record.

custom
cmdTop
Class
manages conflicts
..\classes\checker.bmp
..\classes\checker.bmp
Pixels
datachecker

��� 
���(
%����U;%���
�
��%�$I���
����4�$���UTHISFORM
HELPCONTEXTIDClick,��1A

�qA1
e
)�
	container
�PROCEDURE Error
Parameters nError, cMethod, nLine
This.Parent.Error(nError, cMethod, nLine)
ENDPROC
PROCEDURE Click
THIS.Parent.BeforeRecordPointerMoved

GO TOP

THIS.Parent.RecordPointerMoved
THIS.Parent.EnableDisableButtons

ENDPROC

custom
gHeight = 23
Width = 25
Picture = bts.bmp
Caption = ""
ToolTipText = "Help"
Name = "behindscenes"


commandbutton
{Width = 104
Height = 24
BorderWidth = 1
BackColor = 192,192,192
skiptable = 
enabledisableoninit = .T.
Name = "vcr"


commandbutton
�Height = 18
Width = 25
centerform = .T.
fixedformborder = .T.
cpoint = 
csep = 
cdate = 
ccurrency = 
cdirectory = 
ctalk = OFF
coldhelp = 
chelpfile = solution.chm
cdeleted = 
coldpath = 
Name = "c_solutions"

�PROCEDURE Error
Parameters nError, cMethod, nLine
This.Parent.Error(nError, cMethod, nLine)
ENDPROC
PROCEDURE Click
THIS.Parent.BeforeRecordPointerMoved

GO BOTTOM

THIS.Parent.EnableDisableButtons
THIS.Parent.RecordPointerMoved
ENDPROC

�Top = 0
Left = 78
Height = 24
Width = 26
FontBold = .T.
FontName = "Courier New"
FontSize = 11
Caption = ">|"
TabIndex = 4
ToolTipText = "Bottom"
Name = "cmdBottom"


���� 
�
�
��%
@
	.
�U.4��
����C��
������UNERRORCMETHODNLINETHISPARENTERROR/
���
��#)�
���
��
���
��UTHISPARENTBEFORERECORDPOINTERMOVEDRECORDPOINTERMOVEDENABLEDISABLEBUTTONSError,��Click���1��
2�R��2
]
y�)�


PROCEDURE Error
Parameters nError, cMethod, nLine
This.Parent.Error(nError, cMethod, nLine)
ENDPROC
PROCEDURE Click
THIS.Parent.BeforeRecordPointerMoved

SKIP -1
IF BOF()
	GO TOP
ENDIF

THIS.Parent.RecordPointerMoved
THIS.Parent.EnableDisableButtons

ENDPROC

�Top = 0
Left = 52
Height = 24
Width = 26
FontBold = .T.
FontName = "Courier New"
FontSize = 11
Caption = ">"
TabIndex = 3
ToolTipText = "Next"
Name = "cmdNext"


PROCEDURE Error
Parameters nError, cMethod, nLine
This.Parent.Error(nError, cMethod, nLine)
ENDPROC
PROCEDURE Click
THIS.Parent.BeforeRecordPointerMoved

SKIP 1
IF EOF()
	GO BOTTOM
ENDIF

THIS.Parent.RecordPointerMoved
THIS.Parent.EnableDisableButtons

ENDPROC


�PROCEDURE adjustcontrols
IF THIS.InitialResize
	THIS.LoopThroughControls("INITIALIZE_AND_ADJUST")
	THIS.InitialResize = .F.
ELSE
	THIS.LoopThroughControls("ADJUST")
ENDIF
ENDPROC
PROCEDURE addtoarray
LPARAMETERS oControl
nLen = ALEN(THIS.aControlStats,1)
THIS.aControlStats[nLen,1] = oControl.Top / THIS.InitialFormHeight
THIS.aControlStats[nLen,2] = oControl.Left / THIS.InitialFormWidth
THIS.aControlStats[nLen,3] = oControl.Height / THIS.InitialFormHeight
THIS.aControlStats[nLen,4] = oControl.Width / THIS.InitialFormWidth
THIS.aControlStats[nLen,5] = IIF(TYPE("oControl.FontSize") = 'U', 0, oControl.FontSize)
DIMENSION THIS.aControlStats[nLen+1, 5]

ENDPROC
PROCEDURE setsize
LPARAMETERS oControl, nPos
oControl.Width = THISFORM.Width * THIS.aControlStats[nPos,4]
IF !oControl.Baseclass $ "Textbox Spinner"
	oControl.Height = THISFORM.Height * THIS.aControlStats[nPos,3]
ENDIF


ENDPROC
PROCEDURE loopthroughcontrols
LPARAMETERS cTask
* Valid parameters for cTask are 'Initialize_And_Adjust' and 'Adjust'
cTask = UPPER(cTask)

nOldDecimal = SET("DECIMAL")
SET DECIMAL TO 18

nPos = 0
THISFORM.LockScreen = .T.
FOR m.i = 1 TO THISFORM.ControlCount
	oControl = THISFORM.Controls[m.i]
		nPos = nPos + 1
		If cTask = 'INITIALIZE_AND_ADJUST'
			THIS.AddToArray(oControl)
		ENDIF
		IF oControl.Class$THIS.ResizeList
			THIS.SetSize(oControl, nPos)
		ENDIF
		IF oControl.Class$THIS.RepositionList
			THIS.SetPosition(oControl, nPos)
		ENDIF
		
	*A pageframe can contain only pages
	IF THISFORM.Controls[m.i].Baseclass$"Pageframe"
		*Loop through each page of the pageframe
		FOR m.j = 1 TO THISFORM.Controls[m.i].PageCount
			WITH THISFORM.Controls[m.i].pages[m.j]
				*loop through all the controls on the page
				FOR m.k = 1 TO .ControlCount
					nPos = nPos + 1
					IF cTask = 'INITIALIZE_AND_ADJUST'
						THIS.AddToArray(.Controls[m.k])
					ENDIF
					IF oControl.Class$THIS.ResizeList
						THIS.SetSize(oControl, nPos)
					ENDIF
					IF oControl.Class$THIS.RepositionList
						THIS.SetPosition(oControl, nPos)
					ENDIF
				ENDFOR
			ENDWITH
		ENDFOR
	ENDIF			
ENDFOR

THISFORM.LockScreen = .F.
SET DECIMAL TO nOldDecimal
ENDPROC
PROCEDURE reset
* Call the reset method when you add a control to the form at runtime.
THIS.InitialResize = .T.
DIMENSION THIS.aControlStats[1,5]
THIS.InitialFormHeight = THISFORM.Height
THIS.InitialFormWidth = THISFORM.Width

ENDPROC
PROCEDURE setposition
LPARAMETERS oControl, nPos
oControl.Top = THISFORM.Height * THIS.aControlStats[nPos,1]
oControl.Left = THISFORM.Width * THIS.aControlStats[nPos,2]

ENDPROC
PROCEDURE Init
THIS.InitialFormHeight = THISFORM.Height
THIS.InitialFormWidth = THISFORM.Width
ENDPROC


���� 
�
�
�%*
`
H
�U.4��
����C��
������UNERRORCMETHODNLINETHISPARENTERRORI
���
��
H������%�C��(�#)��
���
��
���
��UTHISPARENTBEFORERECORDPOINTERMOVEDRECORDPOINTERMOVEDENABLEDISABLEBUTTONSError,��Click���1��
2���QA��2
]
y
)�


���� 
�
�
��%)
_
G
�U.4��
����C��
������UNERRORCMETHODNLINETHISPARENTERRORH
���
��	H��

��%�C+��'�#6��
���
��
���
��UTHISPARENTBEFORERECORDPOINTERMOVEDRECORDPOINTERMOVEDENABLEDISABLEBUTTONSError,��Click���1��
2���QA��2
]
y

)�

���� 
���%D{�U6#%�C�_VFP.ActiveFormb�
O��/���C��
��U
ACTIVEFORMREFRESHP
���
��%�C+��7���C�Enabled-����B��T��CO��#)�T�
�CO��#6�T��CO��	#����
H��I
����
����T����-��T����-��T����a��T��	��a�������)
�T����a��T����a��T����-��T��	��-��2�I
���C�Enableda�����U
NRECNTOPNBOTTOMTHISSETALLCMDTOPENABLEDCMDPRIORCMDNEXT	CMDBOTTOM'%�C��
�
�� �
F���
���UTHIS	SKIPTABLE!%���
���
�����UTHISENABLEDISABLEONINITENABLEDISABLEBUTTONS�
4��
��
H���
����
����)T��C�DBF�
Select Table:�Open���%�C�0����F�
�
Q����T���C�����T����������1��
�T��C�����%���
��
�*R,�� Unable to resolve data conflict.���2��
�fT�	��Error Number: CC�Z�C�
 C�
 �Error Message: CEC�
 C�
 �Procedure: C�

t��T�
�C�	�2�x��
H��
��
���
�
���
����
�
���
�X�2��
�B���UNERRORCMETHODNLINE	CNEWTABLETHIS	SKIPTABLENCONFLICTSTATUSDATACHECKER1CHECKCONFLICTSLCMSGLNANSWERrecordpointermoved,��enabledisablebuttons{��beforerecordpointermoved!��Init]��Error���11�A3���
AA�Q�Q���









��
A21
�A3

�A2��
������

A!
D

�A�fA
�
A
A�AAA2
a
���!$#<z*'�9
/)�
$��� 
�%V�t�UF#%�C�THISFORM.Parentb�
O��-�
���
��?�
���
��UTHISFORMSETRELEASETHISFORM�
���
�����
H�#��
����	����JT��C�!Do you want to save your changes?�4�Uncommitted Changes�x��
H��������
������Caa������
����
��Ca����2��
�QT���Error Number: CC�Z�C�
 C�
 CEC�
 C�
 �	Program: C�

t��T��C��2�ERROR�x��
H�I
��
����
��^
�����
��s
�X����
���
�B���UNERRORCMETHODNLINELNCHOICELCMSGClick,��Error���11���A2�q�!
��
�
�A��
�
A
A
AAA2
g
�()

DPROCEDURE recordpointermoved
IF TYPE('_VFP.ActiveForm') = 'O'
	_VFP.ActiveForm.Refresh
ENDIF

ENDPROC
PROCEDURE enabledisablebuttons
LOCAL nRec, nTop, nBottom
IF EOF() && Table empty or no records match a filter
	THIS.SetAll("Enabled", .F.)
	RETURN
ENDIF

nRec = RECNO()
GO TOP
nTop = RECNO()
GO BOTTOM
nBottom = RECNO()
GO nRec

DO CASE
	CASE nRec = nTop
		THIS.cmdTop.Enabled = .F.
		THIS.cmdPrior.Enabled = .F.
		THIS.cmdNext.Enabled = .T.
		THIS.cmdBottom.Enabled = .T.
	CASE nRec = nBottom
		THIS.cmdTop.Enabled = .T.
		THIS.cmdPrior.Enabled = .T.
		THIS.cmdNext.Enabled = .F.
		THIS.cmdBottom.Enabled = .F.
	OTHERWISE
		THIS.SetAll("Enabled", .T.)
ENDCASE
ENDPROC
PROCEDURE beforerecordpointermoved
IF !EMPTY(This.SkipTable)
	SELECT (This.SkipTable)
ENDIF

ENDPROC
PROCEDURE Init
IF THIS.EnableDisableOnInit
	THIS.EnableDisableButtons
ENDIF
ENDPROC
PROCEDURE Error
Parameters nError, cMethod, nLine
#define NUM_LOC "Error Number: "
#define PROG_LOC "Procedure: "
#define MSG_LOC "Error Message: "
#define CR_LOC CHR(13)
#define SELTABLE_LOC "Select Table:"
#define OPEN_LOC "Open"
#define SAVE_LOC "Do you want to save your changes anyway?"
#define CONFLICT_LOC "Unable to resolve data conflict."

DO CASE
	CASE nError = 13 && Alias not found
	*-----------------------------------------------------------
	* If the user tries to move the record pointer when no
	* table is open or when an invalid SkipTable property has been
	* specified, prompt the user for a table to open.
	*-----------------------------------------------------------
		cNewTable = GETFILE('DBF', SELTABLE_LOC, OPEN_LOC)
		IF FILE(cNewTable)
			SELECT 0
			USE (cNewTable)
			This.SkipTable = ALIAS()
		ELSE
			This.SkipTable = ""
		ENDIF
	CASE nError = 1585 
	*-----------------------------------------------------------
	* Update conflict handled by datachecker class.
	*-----------------------------------------------------------
		nConflictStatus = THIS.DataChecker1.CheckConflicts()
		IF nConflictStatus = 2
			WAIT WINDOW CONFLICT_LOC
		ENDIF
	OTHERWISE
	*-----------------------------------------------------------
	* Display information about an unanticipated error.
	*-----------------------------------------------------------
		lcMsg = NUM_LOC + ALLTRIM(STR(nError)) + CR_LOC + CR_LOC + ;
				MSG_LOC + MESSAGE( )+ CR_LOC + CR_LOC + ;
				PROG_LOC + PROGRAM(1)
		lnAnswer = MESSAGEBOX(lcMsg, 2+48+512)
		DO CASE
			CASE lnAnswer = 3 &&Abort
				CANCEL
			CASE lnAnswer = 4 &&Retry
				RETRY
			OTHERWISE
				RETURN
		ENDCASE
ENDCASE

ENDPROC

���� 
���|%|K5��U
�%�C�

�
MS Sans Serif�
��$�
�!C�
�
MS Sans Serif�
��$�
�!C�
�
MS Sans Serif�
��$�
�!C�
�
MS Sans Serif�
��$����� ��C�fontname�Arial��
�����(��C�fontname�
MS Sans Serif��
�����C�fontsize�
��
��UTHISSETALL�%���
��z����T���C�PATHv����CC�Q�FFC������CC�Q�WIZARDS������CC�Q�GALLERY�����UTHISLSETFFCPATH	LCFFCPATHCSAVESETPATH	ADDTOPATHC/%�C�THIS.c_solutions1.Baseclassb�
C��<�
���
���UTHISC_SOLUTIONS1RESTOREHELPC/%�C�THIS.c_solutions1.Baseclassb�
C��<�
���
���UTHISC_SOLUTIONS1SAVEHELPSG&(�%���
��L�%�C�����1�	G)(���H�G)(�������UTHISLSETFFCPATHCSAVESETPATH
�����
�T��C����T��CC�PATHv���%�C����
����
H�U����C��
;���
��t�B��CC����
;���
����B��CC�C�>R���
����B���%�C������G)(�����
�-G)(��CC��

R�
;����
;6����UTCPATHLCPATH	LCSETPATHInit,��LoadF
��
Deactivate��Activatej��Unload���	addtopathG��1d	
��A�
3

qa
q
�
�
A3��A3��A3a

!
���AA3qr�Q
b
��
A�
A�
AAA����A2
I

d

:����#!�}.)�
!�PROCEDURE handlerecord
*---------------------------------------------------------------*
*  This method is called from the CheckConflicts method and the 
*  VerifyEachChange method.  It loops through each field in the
*  current record and compares the current value with the value
*  stored in the table. If a value of 1 is passed to this method,
*  the method also compares the current value with the value in
*  the field before user made any edits.
*
*  RETURNS NUMERIC VALUES:
*    0 -- No Change Made to the Current Value
*    1 -- Successfully Made User-Specified Change
*	 2 -- Unable to Make User-Specifed Change
*---------------------------------------------------------------*

LPARAMETERS lnScope

*--Valid values for lnScope:
* 	0 - Only manage conflicts   && default
*   1 - Also prompt for changed values

* Verify parameter
IF TYPE("m.lnScope") != "N"
	m.lnScope = 0 
ENDIF
IF !BETWEEN(m.lnScope, 0, 1)
	#define WINDMSG_LOC "Invalid value passed to conflictmanager.handlerecord"
	WAIT WINDOW WINDMSG_LOC
ENDIF

* Declare constants & variables
#define CR_LOC CHR(13)
#define SAVE_LOC "Do you want to overwrite the current value with your change?" + CR_LOC + "(Choose 'Cancel' to restore the original value.)"
#define CONFLICT_LOC "Data Conflict"
#define VERIFY_LOC "Verify Changes"
#define ORG_LOC "Original Value: "
#define CUR_LOC "Current Value: " 
#define CHG_LOC "Your change: "
#define MEMO_LOC " is a Memo field."
#define FIELD_LOC "Field: "
#define RECORD_LOC "Record Number: "
#define VALCHG1_LOC "A value has been changed by another user."
#define VALCHG2_LOC "A value has been changed."

LOCAL lnChoice, lnField, lcField, luOldVal, luCurVal, luField, llMadeChange, llSuccess
m.llMadeChange = .F.
m.llSuccess = .T.

* refresh current record in views before checking for conflicts
IF CURSORGETPROP('SourceType') != 3 && not a local table
	=REFRESH()
ENDIF

* Check each field in the record for conflict or value change
FOR m.lnField = 1 to FCOUNT()
	m.lnChoice = 0
	
	m.lcField = FIELD(m.lnField)
	IF TYPE(m.lcField) = "G"
		LOOP && Can't check general fields
	ENDIF
	m.luOldVal = OLDVAL(m.lcField)
	m.luCurVal = CURVAL(m.lcField)
	
	DO CASE
		* -----< check for conflicts only >--------
		CASE m.lnScope = 0
			IF m.luOldVal != m.luCurVal
				m.llMadeChange = .T.  
				m.lnChoice = MESSAGEBOX(VALCHG1_LOC + CR_LOC + FIELD_LOC + lcField + CR_LOC + ;
				RECORD_LOC + ALLTRIM(STR(RECNO())) + ;
					IIF(TYPE("m.lcField") != "M", CR_LOC + CR_LOC + ORG_LOC + THIS.String(m.luOldVal) + ;
					CR_LOC + CUR_LOC + THIS.String(m.luCurVal) + ;
					CR_LOC + CHG_LOC + THIS.String(EVAL(m.lcField)), CR_LOC + CR_LOC + m.lcField + MEMO_LOC) + ;
					CR_LOC + CR_LOC + SAVE_LOC, + 3+48+0, CONFLICT_LOC)					
			ENDIF
		* -----< check for conflicts and verify all changes >--------
		CASE m.lnScope = 1 && Verify all changes
			m.luField = EVAL(m.lcField)
			IF m.luOldVal != m.luField OR m.luCurVal != m.luField
				m.llMadeChange = .T.  
				m.lnChoice = MESSAGEBOX(VALCHG2_LOC + CR_LOC + FIELD_LOC + m.lcField + CR_LOC + ;
				RECORD_LOC + ALLTRIM(STR(RECNO())) + ;
					IIF(TYPE("m.lcField") != "M", CR_LOC + CR_LOC + ORG_LOC + THIS.String(m.luOldVal) + ;
					CR_LOC + CUR_LOC + THIS.String(m.luCurVal) + ;
					CR_LOC + CHG_LOC + THIS.String(EVAL(m.lcField)), CR_LOC  + CR_LOC + m.lcField + MEMO_LOC) + ;
				CR_LOC + CR_LOC + SAVE_LOC, + 3+48+0, VERIFY_LOC)
			ENDIF
	ENDCASE
	DO CASE
	CASE m.lnChoice = 7 && No, don't save changes
		REPLACE (m.lcField) WITH m.luCurVal
	CASE m.lnChoice = 2 && Cancel, restore original value
		REPLACE (m.lcField) WITH m.luOldVal
	ENDCASE
ENDFOR
IF m.llMadeChange
	m.llSuccess = TABLEUPDATE(.F., .T.)
	RETURN IIF(m.llSuccess, 1, 2)
ELSE
	RETURN 0 
ENDIF

ENDPROC
PROCEDURE string
*---------------------------------------------------------------*
*  This method is called from the HandleRecord method.  It 
*  returns the character equivalent of the value passed in as a
*  parameter.  If a memo field is passed in, a notice to this
*  effect is returned rather than the value in the memo field so
*  that potentially large amounts of text aren't displayed in the 
*  messagebox.
*---------------------------------------------------------------*

LPARAMETERS luValue

m.uType = TYPE('m.luValue')
DO CASE
	CASE m.uType = 'C'
		RETURN ALLTRIM(m.luValue)
	CASE INLIST(m.uType, 'N', 'Y')
		RETURN ALLTRIM(STR(m.luValue))
	CASE m.uType = 'D'
		RETURN DTOC(m.luValue)
	CASE m.uType = 'T'
		RETURN TTOC('m.luValue')
	CASE m.uType = 'L'
		RETURN IIF(m.luValue, '.T.', '.F.')
	CASE uType = 'M'
		RETURN 'Memo field'
ENDCASE
ENDPROC
PROCEDURE verifychanges
*---------------------------------------------------------------*
*  If any changes have been made to the table or record, prompt the
*  user to save the changes.  If the user says 'yes,' all changes
*  are saved.  Any changes made to the data by other users after
*  this user made the change and before the change was committed
*  will be lost.
*
*  RETURNS NUMERIC VALUES:
*    0 -- No Changes Made to the Current Values
*    1 -- Successfully Made All User Changes
*	 2 -- Unable to Write One or More User-Specifed Changes to Table
*---------------------------------------------------------------*

* Declare constants & variables
#define SAVECHG_LOC 'Do you want to save your changes?'
#define SAVECHG2_LOC 'Save Changes'
#define NOBUFF_LOC2 'Data buffering is not enabled.'

LOCAL lnChoice, llMadeChange, lnSuccess
m.llMadeChange = .F.
m.lnSuccess = 0

* If the user has changed anything, prompt to save or discard changes
DO CASE
	CASE INLIST(CURSORGETPROP('Buffering'), 2,3) && Row Buffering
		IF '2' $ GETFLDSTATE(-1)
			m.llMadeChange = .T.
		ENDIF
	CASE INLIST(CURSORGETPROP('Buffering'), 4,5) && Table Buffering
		IF GETNEXTMODIFIED(0) > 0
			m.llMadeChange = .T.
		ENDIF
	OTHERWISE
		WAIT WINDOW NOBUFF_LOC NOWAIT
ENDCASE

IF m.llMadeChange
	m.lnChoice = MESSAGEBOX(SAVECHG_LOC, 4+32, SAVECHG2_LOC)
	IF m.lnChoice = 6 && Yes
		m.lnSuccess = IIF(TABLEUPDATE(.T.,.T.), 1, 2)
	ELSE
		=TABLEREVERT(.T.)
	ENDIF
ENDIF	
RETURN m.lnSuccess
ENDPROC
PROCEDURE verifyeachchange
*--------------------------------------------------------------------
*  If any changes have been made to the table or record, for each
*  change, display the old value and the new value, prompting the
*  user to save or discard the change.  Conflict management is also
*  included in the HandleRecord method.
*
*  RETURNS NUMERIC VALUES:
*    0 -- No Changes Made to the Current Values
*    1 -- Successfully Made User-Specified Changes
*	 2 -- Unable to Write One or More User-Specifed Changes to Table
*---------------------------------------------------------------*

#define NOBUFF_LOC3 'Data buffering is not enabled.'
LOCAL lnSuccess, lnRec
m.lnSuccess = 0

DO CASE
	CASE INLIST(CURSORGETPROP('Buffering'), 2,3) && Row Buffering
		IF '2' $ GETFLDSTATE(-1)				 && Data has changed
			m.lnSuccess = THIS.HandleRecord(1)
		ENDIF	
	CASE INLIST(CURSORGETPROP('Buffering'), 4,5) && Table Buffering
		m.lnRec = GETNEXTMODIFIED(0)
		DO WHILE m.lnRec > 0
			GO m.lnRec
			m.lnSuccess = IIF(m.lnSuccess != 2, THIS.HandleRecord(1), 2)
			m.lnRec = GETNEXTMODIFIED(m.lnRec)	
		ENDDO
	OTHERWISE									 && No Buffering
		WAIT WINDOW NOBUFF_LOC NOWAIT
ENDCASE
RETURN m.lnSuccess
ENDPROC
PROCEDURE checkconflicts
*---------------------------------------------------------------*
*  Checks to see whether another user has changed the value 
*  stored in a table.  If so, calls HandleRecord to display
*  the new value and allow the user to decide what to do.
*
*  RETURNS NUMERIC VALUES:
*    0 -- No Changes Made to the Current Values
*    1 -- Successfully Made User-Specified Changes
*	 2 -- Unable to Make Write One or More User-Specifed Changes to Table
*---------------------------------------------------------------*

#define NOBUFF1_LOC 'Data buffering is not enabled.'
LOCAL lnSuccess, llnRec
m.lnSuccess = 0  

DO CASE
	CASE INLIST(CURSORGETPROP('Buffering'), 2,3) && Row Buffering
		IF '2' $ GETFLDSTATE(-1)				 && Data has changed
			m.lnSuccess = THIS.HandleRecord(0)
		ENDIF	
	CASE INLIST(CURSORGETPROP('Buffering'), 4,5) && Table Buffering
		m.llnRec = GETNEXTMODIFIED(0)
		DO WHILE m.llnRec > 0
			GO m.llnRec
			m.lnSuccess = IIF(m.lnSuccess != 2, THIS.HandleRecord(0), 2)
			m.llnRec = GETNEXTMODIFIED(m.llnRec)	
		ENDDO
	OTHERWISE									 && no buffering
		WAIT WINDOW NOBUFF_LOC NOWAIT
ENDCASE
RETURN m.lnSuccess
ENDPROC


��� 


�J%7Y	K��Uh%���
��C�%��C�INITIALIZE_AND_ADJUST����T��
�-���a���C�ADJUST�����UTHIS
INITIALRESIZELOOPTHROUGHCONTROLS
���T�
�C���

���&T����
���

��������&T����
���
��������&T����
���
��������&T����
���
����	����ET����
���
��CC�oControl.FontSizeb�
U��
���
6������
�

���
��UOCONTROLNLENTHIS
ACONTROLSTATSTOPINITIALFORMHEIGHTLEFTINITIALFORMWIDTHHEIGHTWIDTHFONTSIZEz���
�"T�����C�
�
����$%����Textbox Spinner

��s�"T�����C�
�
�����UOCONTROLNPOSWIDTHTHISFORMTHIS
ACONTROLSTATS	BASECLASSHEIGHT����T��C�f��T�
�C�DECIMALv��G
(����
T���
��T���a����
���

�(�����|�T��C�
�����T����

��&%���INITIALIZE_AND_ADJUST������C��	�
���%����	�
������C���	�
���%����	�
��-
���C���	����'%�C�
�����	Pageframe
��x�&��
���

�(�C�
������t�!��C�
�C�
������p���
���

�(�����l�T����

��&%���INITIALIZE_AND_ADJUST�����CC�
����	�
���%����	�
��8���C���	�
���%����	�
��h���C���	�������������T���-��G
(��
��UCTASKNOLDDECIMALNPOSTHISFORM
LOCKSCREEN
ICONTROLCOUNTOCONTROLCONTROLSTHIS
ADDTOARRAYCLASS
RESIZELISTSETSIZEREPOSITIONLISTSETPOSITION	BASECLASS
J	PAGECOUNTPAGES
KMT��
�a������

���
��T�������T�������UTHIS
INITIALRESIZE
ACONTROLSTATSINITIALFORMHEIGHTTHISFORMHEIGHTINITIALFORMWIDTHWIDTHR���
�"T�����C�
�

����"T�����C�
�
����U	OCONTROLNPOSTOPTHISFORMHEIGHTTHIS
ACONTROLSTATSLEFTWIDTH)T��
�����T�������UTHISINITIALFORMHEIGHTTHISFORMHEIGHTINITIALFORMWIDTHWIDTHadjustcontrols,��
addtoarray���setsizeJ��loopthroughcontrols��resett��setposition'��Init���1

Q��a
A2qQ
aaaaQ�
3�!A!A4q�b
����
q

a
Aq
Q
Aq
Q
Asb�

a�
Aq
Q
Aq
Q
AAAAAA��2�a
1
1
3�!!31
1
1
�
��	����?��	ND�	K
VHf
�
\)

�PROCEDURE Init
IF  fontmetric(1, 'MS Sans Serif', 8, '') # 13 OR ;
	fontmetric(4, 'MS Sans Serif', 8, '') # 2 OR ;
	fontmetric(6, 'MS Sans Serif', 8, '') # 5 OR ;
	fontmetric(7, 'MS Sans Serif', 8, '') # 11
	this.setall('fontname', 'Arial')
ELSE
	this.setall('fontname','MS Sans Serif')
ENDIF
this.setall('fontsize',8)

ENDPROC
PROCEDURE Load
IF THIS.lSetFFCPath
	LOCAL lcFFCPath
	THIS.cSaveSetPath = SET("PATH")
	THIS.AddToPath(HOME()+"FFC")
	THIS.AddToPath(HOME()+"WIZARDS")
	THIS.AddToPath(HOME()+"GALLERY")
ENDIF

ENDPROC
PROCEDURE Deactivate
IF TYPE("THIS.c_solutions1.Baseclass")="C"
	THIS.c_solutions1.restoreHelp
ENDIF

ENDPROC
PROCEDURE Activate
IF TYPE("THIS.c_solutions1.Baseclass")="C"
	THIS.c_solutions1.saveHelp
ENDIF

ENDPROC
PROCEDURE Unload
SET MESSAGE TO
IF THIS.lSetFFCPath
	IF EMPTY(THIS.cSaveSetPath)
		SET PATH TO
	ELSE
		SET PATH TO (THIS.cSaveSetPath)
	ENDIF
ENDIF

ENDPROC
PROCEDURE addtopath
LPARAMETER tcPath

LOCAL lcPath
tcPath = ALLTRIM(tcPath)
lcSetPath = ALLTRIM(SET("PATH"))

IF ATC(tcPath,lcSetPath)#0
	DO CASE
	CASE ATC(tcPath+";",lcSetPath)#0
		RETURN
	CASE ATC(ADDBS(tcPath)+";",lcSetPath)#0
		RETURN
	CASE ATC(RIGHT(lcSetPath,LEN(tcPath)),tcPath)#0
		RETURN
	ENDCASE
ENDIF

IF EMPTY(lcSetPath)
	SET PATH TO (tcPath)	
ELSE
	SET PATH TO (lcSetPath + IIF(RIGHT(lcSetPath,1)=";","",";") + tcPath)
ENDIF

ENDPROC

���� 
����%��
�UO���%�C�	m.lnScopeb�
N��3�T�
���
���%�C�
��
�

�
����>R,��4Invalid value passed to conflictmanager.handlerecord���#��
��������
T�
��-��
T�
��a��%�C�
SourceType��
����	��C������
���

�(�C.����T�
�
��
��T�
��C�
�/��%�C�
�b�
G��M
�.��T�
��C�
��_��T�
��C�
����
H��
�����
��
����%��
��
�����
T�
��a���
T�
�
�C�)A value has been changed by another user.C�
 �Field: �C�
 �Record Number: CCCOZ�CC�	m.lcFieldb�
M�}C�
 C�
 �Original Value: C�
��	�
C�
 �Current Value: C�
��	�
C�
 �
Your change: CC�
���	�
�&C�
 C�
 �
�� is a Memo field.6C�
 C�
 �<Do you want to overwrite the current value with your change?C�
 �0(Choose 'Cancel' to restore the original value.)�3�
Data Conflict�x�����
��

����T�
��C�
����$%��
��
���
��
�����
T�
��a���
T�
�
�C�A value has been changed.C�
 �Field: �
�C�
 �Record Number: CCCOZ�CC�	m.lcFieldb�
M�}C�
 C�
 �Original Value: C�
��	�
C�
 �Current Value: C�
��	�
C�
 �
Your change: CC�
���	�
�&C�
 C�
 �
�� is a Memo field.6C�
 C�
 �<Do you want to overwrite the current value with your change?C�
 �0(Choose 'Cancel' to restore the original value.)�3�Verify Changes�x����
H�������
�
�
����>��
�����
�����
�
�
����>��
�����
������%��
���7�T�
��C-a���B�C�
���

��
6���H�	B��
���ULNSCOPELNCHOICELNFIELDLCFIELDLUOLDVALLUCURVALLUFIELDLLMADECHANGE	LLSUCCESSTHISSTRING 
���T�
�
�C�	m.luValueb��
H�.�
���
�
�
C��O�
B�C�
�����C�
�
�
N�
Y���w�B�CC�
�Z�����
�
�
D����
B�C�
�*����
�
�
T����B�C�	m.luValue�����
�
�
L����B�C�
��	�.T.��.F.6����
�
M��
�B��
Memo field���ULUVALUEUTYPE�
���
��
T�
�
�-��T�
���
��
H�8���!�CC�	Buffering��
�
�����%��
2C����
��|�
T�
�
�a���!�CC�	Buffering��
�
�����%�C�
��
����
T�
�
�a���2���R,:�����%��
�
��y
�ET�
��C�!Do you want to save your changes?�$�Save Changes�x��%��
��
��c
�T�
��CCaa���

��
6���u
�
��Ca�����B��
���ULNCHOICELLMADECHANGE	LNSUCCESS
NOBUFF_LOC1
���
�T�
���
��
H�'�
�!�CC�	Buffering��
�
���x�%��
2C����
��t�T�
��C�

�����!�CC�	Buffering��
�
���
�T�
�
�C�
���+��
�
�
��
�#��
�
��*T�
��C�
��
�
C�

����
6��T�
�
�C�
�
����2�
�R,:�����B��
���U	LNSUCCESSLNRECTHISHANDLERECORD
NOBUFF_LOC1
���
�T�
���
��
H�'�
�!�CC�	Buffering��
�
���x�%��
2C����
��t�T�
��C�
�����!�CC�	Buffering��
�
���
�T�
�
�C�
���+��
�
�
��
�#��
�
��*T�
��C�
��
�
C�
����
6��T�
�
�C�
�
����2�
�R,:�����B��
���U	LNSUCCESSLLNRECTHISHANDLERECORD
NOBUFF_LOChandlerecord,��string���
verifychanges��verifyeachchange�	��checkconflictsA��1�
�A�
�A�1���
�A�
�2
a
AAA
A
�2
Q
�VA2
1
A��AA�1
A
1
A
AA�
�
��A3z�
�A
��
�A
�A
Q
A
�
!
1
A2 
����a
�AA
�A��A�Q1
�
��AA�2���a
a
A!
A
��A
A��A�2���a
a
A!
A
��A
A��A�1
�
2�WiC{K�]r%�pJ�!�)�
�centerform If .T., Thisform.Autocenter is set to .T.
fixedformborder If .T., borderstyle of the form is set to .T.
cpoint old SET POINT TO setting
csep Old SET SEPARATOR TO setting
cdate Old SET DATE TO setting
ccurrency Old SET CURRENCY TO setting
cdirectory Stores the SET DEFAULT directory when the form was run and restores it after the form is closed.
ctalk
autosetdefault Whether or not to set the default directory in the Init of the class
coldhelp original help file
chelpfile Help file for the sample
cdeleted
coldpath
lcalledbysolution
*getdirectory 
*savehelp Saves the current help file setting.
*restorehelp Restores the help file setting previously saved.
*addtopath 

	���� 
�	�	�%9	dq�U����%�C�lcFileb�
L��n�%�C�THISFORMb�
O��P�T��C���
]���j�T��C��

]����B�C�����ULCFILETHISFORMw%%��SOLUTIONCC�HELP�

vf

��>�T��
�C�HELP�

v���%�C���
�	C��0	��p�G(������UTHISCOLDHELP	CHELPFILEW%�C��
�
��P�%�C��
0��4�G(���
���L�G(�C��
�����UTHISCOLDHELP
�����
�T��C����T��CC�PATHv���%�C����
����
H�U����C��
;���
��t�B��CC����
;���
����B��CC�C�>R���
����B���%�C������G)(�����
�-G)(��CC��

R�
;����
;6����UTCPATHLCPATH	LCSETPATHD
T���
���
SET TALK &cMacro
T���
���
SET DELETED &cMacro
G;(��
���G<(��
���G(��
���G8(��
���
��
��%�C�
�	�����	G)(�����G)(��
�	���%��
�
�
C�
��
	����G(��
����1%��
��C�solutionb�
U�C�
�
	��=
�
��
��T���-���UCMACROTHISCTALKCDELETEDCPOINTCSEPCDATE	CCURRENCYRESTOREHELPCOLDPATHAUTOSETDEFAULT
CDIRECTORYLCALLEDBYSOLUTIONSOLUTIONSHOWTHISFORMVISIBLE$���
��)%�C�
SOLUTIONS.CC���t�

t��
��F�T���a���T���a��T�������%���	����T��
��
���T���C�PATHv��T��C����T��C�
�Q����C��CLASSES��
����C��SOLUTION��
����C���
��T���C�DEFAULTvC���%�����F
�G(�����T���C�POINTv��T���C�	SEPARATORv��T���C�DATEv��T���C�CURRENCY�

v��T���C�TALKv��T���C�DELETEDv��G;(��
.��G<(��
,��G(��AMERICAN��G8(��
$��G �G2�ULCDIR
LCSAMPLEPATHSLCHOMETHISLCALLEDBYSOLUTIONTHISFORMSHOWTIPS
AUTOCENTER
CENTERFORMFIXEDFORMBORDERBORDERSTYLECOLDPATHGETDIRECTORY	ADDTOPATH
CDIRECTORYAUTOSETDEFAULTCPOINTCSEPCDATE	CCURRENCYCTALKCDELETEDgetdirectory,��savehelp���restorehelpY
��	addtopath�
��Destroy���Init���1r�
�
1
�!
AA�3Q�
A�
�A31
!
��

AA3qr�Q
b
��
A�
A�
AAA����A3
A


q
�����"
���A�
�A��A2���A�1




Ab



�
�

�


�As
�
a
�
a
�
��1
�aa2



,
�
��d#.�z<D�k`)�	
vPROCEDURE getdirectory
* Return the directory name from a file
LPARAMETERS lcFile

IF TYPE("lcFile") = "L" && No parameter passed in
	IF TYPE("THISFORM") = "O"
		lcFile = SYS(1271, THISFORM)
	ELSE
		lcFile = SYS(16,1)
	ENDIF
ENDIF

RETURN JUSTPATH(lcFile)

ENDPROC
PROCEDURE savehelp
IF !"SOLUTION" $ UPPER(SET("HELP",1)) THEN
	THIS.cOldHelp = SET("HELP",1)
ENDIF
IF !EMPTY(THIS.cHelpFile) AND FILE(THIS.cHelpFile) THEN
	SET HELP TO (THIS.cHelpFile)
ENDIF

ENDPROC
PROCEDURE restorehelp
IF !EMPTY(THIS.cOldHelp)
	IF FILE(THIS.cOldHelp)
		SET HELP TO (THIS.cOldHelp)
	ELSE
		SET HELP TO EVAL(THIS.cOldHelp)
	ENDIF
ENDIF

ENDPROC
PROCEDURE addtopath
LPARAMETER tcPath

LOCAL lcPath
tcPath = ALLTRIM(tcPath)
lcSetPath = ALLTRIM(SET("PATH"))

IF ATC(tcPath,lcSetPath)#0
	DO CASE
	CASE ATC(tcPath+";",lcSetPath)#0
		RETURN
	CASE ATC(ADDBS(tcPath)+";",lcSetPath)#0
		RETURN
	CASE ATC(RIGHT(lcSetPath,LEN(tcPath)),tcPath)#0
		RETURN
	ENDCASE
ENDIF

IF EMPTY(lcSetPath)
	SET PATH TO (tcPath)	
ELSE
	SET PATH TO (lcSetPath + IIF(RIGHT(lcSetPath,1)=";","",";") + tcPath)
ENDIF

ENDPROC
PROCEDURE Destroy
* Restore old SET settings.  This isn't necessary for forms 
* with a Private DataSession

cMacro = THIS.cTalk
SET TALK &cMacro
cMacro = THIS.cDeleted
SET DELETED &cMacro
	
SET POINT TO THIS.cPoint
SET SEPARATOR TO THIS.cSep
SET DATE TO (THIS.cDate)
SET CURRENCY TO THIS.cCurrency

THIS.restoreHelp

IF EMPTY(THIS.cOldPath)
	SET PATH TO
ELSE
	SET PATH TO (THIS.cOldPath)
ENDIF

IF THIS.AutoSETDEFAULT AND !EMPTY(THIS.cDirectory)
	SET DEFAULT TO (THIS.cDirectory)
ENDIF


* If this form is run from the solutions form,
* the hidden form object, solutions, is made visible when
* this control is destroyed.

IF THIS.lCalledBySolution AND NOT (TYPE('solution')='U' OR ISNULL(solution))
	Solution.Show
	THISFORM.Visible = .F.
ENDIF
ENDPROC
PROCEDURE Init
#define POINT_LOC "."
#define SEP_LOC ","
#define DATE_LOC "AMERICAN"
#define CURRENCY_LOC "$"
*----------------------< c_solutions >-----------------------*
* This class is added to all forms in the Solutions
* sample suite.
*---------------------------------------------------------*
LOCAL lcDir, lcSamplePaths, lcHome

IF ATC("SOLUTIONS.",PROG(PROG(-1)-1))#0
	THIS.lCalledBySolution = .T.
ENDIF

THISFORM.ShowTips = .T.
THISFORM.AutoCenter = This.CenterForm
IF THIS.FixedFormBorder
	THISFORM.BorderStyle = 2 && Fixed Dialog
ENDIF

THIS.cOldPath = SET("PATH")
lcDir= THIS.GetDirectory()	&&directory of sample
lcHome = HOME(2)

THIS.AddToPath(lcHome+"CLASSES")
THIS.AddToPath(lcHome+"SOLUTION")
THIS.AddToPath(lcDir)

THIS.cDirectory = SET("DEFAULT") + CURDIR()
IF THIS.AutoSETDEFAULT
	SET DEFAULT TO (lcDir)
ENDIF

* Save old settings to be restored.
THIS.cPoint = SET("POINT")
THIS.cSep = SET("SEPARATOR")
THIS.cDate = SET("DATE")
THIS.cCurrency = SET("CURRENCY", 1)
THIS.cTalk = SET("TALK")
THIS.cDeleted = SET("DELETED")

SET POINT TO POINT_LOC
SET SEPARATOR TO SEP_LOC
SET DATE TO DATE_LOC
SET CURRENCY TO CURRENCY_LOC
SET DELETED ON && ignore records marked for deletion
SET TALK OFF

ENDPROC