Mini Kabibi Habibi
y� VERSION = 3.00 _data.hV^ �$ _datanavbtns Pixels (Courier New, 1, 11, 9, 17, 12, 11, 5, 0
_data.h _navbtns Class Pixels 6 graphics\vcr.bmp 5 graphics\vcr.bmp graphics\vcr.bmp Class custom Vcrtop VCR Buttons with Data Checker
_container _datanavbtns �� � � "R % � � � � U 6 %�C� �
�� � B�-�� � #)�
��C� � �� B� U THIS
SETSESSION REFRESHFORM Click, ��1 !q A Q � A 2 c ) � _datanavbtns Datachecker1 cmdBottom "Arial, 0, 10, 6, 16, 13, 23, 3, 0
graphics\vcr.bmp Standard VCR Buttons
_container DTop = 6
Left = 44
Height = 15
Width = 23
Name = "Datachecker1"
_datanav.vcx _datachecker �PROCEDURE Click
THIS.Parent.BeforeRecordPointerMoved
GO BOTTOM
THIS.Parent.EnableDisableButtons
THIS.Parent.RecordPointerMoved
ENDPROC
PROCEDURE Error
Parameters nError, cMethod, nLine
This.Parent.Error(nError, cMethod, nLine)
ENDPROC
_datanavbtns
commandbutton _base.vcx 1 _navbtns _commandbutton cmdNext _navbtns Pixels �� �4 % � �
� � U L %�C� �
�� � B�-�� �
%�C
��4 �
H������ �
��C� � �� B� U THIS
SETSESSION REFRESHFORM Click, ��1 !q A � � A � A 2 z ) `Top = 0
Left = 72
Height = 24
Width = 24
Picture = graphics\bottom.bmp
Name = "Vcrbottom"
Vcrbottom
commandbutton _datanav.vcx 1 ��� � � �� % @ . � U /
�� � � � #6�
�� � � �
�� � � � U THIS PARENT BEFORERECORDPOINTERMOVED ENABLEDISABLEBUTTONS RECORDPOINTERMOVED. 4� � � � ��C � � � � � � �� U NERROR CMETHOD NLINE THIS PARENT ERROR Click, �� Error� ��1 � R � � 2 � �1 � � � ) � _datanavbtns
_cmdbottom
commandbutton _base.vcx _navbtns :�� ! ! F % � �
� � U ` %�C� �
�� � B�-�� �
%�C+
��. � H� � %�C+��H �
H������ �
��C� � �� B� U THIS
SETSESSION REFRESHFORM Click, ��1 !q A � A A � � A � A 2 � ) ! _commandbutton _datanavbtns cmdPrior
commandbutton _base.vcx _commandbutton _datanavbtns 1 �Top = 0
Left = 78
Height = 24
Width = 26
FontBold = .T.
FontName = "Courier New"
FontSize = 11
Caption = ">|"
TabIndex = 4
ToolTipText = "Bottom"
Name = "cmdBottom"
PROCEDURE Click
THIS.Parent.BeforeRecordPointerMoved
SKIP 1
IF EOF()
GO BOTTOM
ENDIF
THIS.Parent.RecordPointerMoved
THIS.Parent.EnableDisableButtons
ENDPROC
PROCEDURE Error
Parameters nError, cMethod, nLine
This.Parent.Error(nError, cMethod, nLine)
ENDPROC
Vcrnext 1 cmdTop
commandbutton
commandbutton �� � � �� % ) _ G � U H
�� � � � H���� %�C+��' � #6� �
�� � � �
�� � � � U THIS PARENT BEFORERECORDPOINTERMOVED RECORDPOINTERMOVED ENABLEDISABLEBUTTONS. 4� � � � ��C � � � � � � �� U NERROR CMETHOD NLINE THIS PARENT ERROR Click, �� Error� ��1 � � � Q A � � 3 � �1 � �
) � �Top = 0
Left = 52
Height = 24
Width = 26
FontBold = .T.
FontName = "Courier New"
FontSize = 11
Caption = ">"
TabIndex = 3
ToolTipText = "Next"
Name = "cmdNext"
�Top = 0
Left = 26
Height = 24
Width = 26
FontBold = .T.
FontName = "Courier New"
FontSize = 11
Caption = "<"
TabIndex = 2
ToolTipText = "Prior"
Name = "cmdPrior"
_base.vcx _commandbutton _cmdnext �� � � � % * ` H � U I
�� � � �
H������ %�C ��( � #)� �
�� � � �
�� � � � U THIS PARENT BEFORERECORDPOINTERMOVED RECORDPOINTERMOVED ENABLEDISABLEBUTTONS. 4� � � � ��C � � � � � � �� U NERROR CMETHOD NLINE THIS PARENT ERROR Click, �� Error� ��1 � � � Q A � � 3 � �1 � �
) � PROCEDURE Click
THIS.Parent.BeforeRecordPointerMoved
SKIP -1
IF BOF()
GO TOP
ENDIF
THIS.Parent.RecordPointerMoved
THIS.Parent.EnableDisableButtons
ENDPROC
PROCEDURE Error
Parameters nError, cMethod, nLine
This.Parent.Error(nError, cMethod, nLine)
ENDPROC
�Width = 104
Height = 24
BorderWidth = 1
BackColor = 192,192,192
skiptable =
enabledisableoninit = .T.
Name = "_datanavbtns"
container 3 \Top = 0
Left = 48
Height = 24
Width = 24
Picture = graphics\next.bmp
Name = "Vcrnext"
_datanav.vcx dTop = 0
Left = 24
Height = 24
Width = 24
Picture = graphics\previous.bmp
Name = "Vcrprevious"
_navbtns Vcrprevious
commandbutton _datanav.vcx _cmdprevious YTop = 0
Left = 0
Height = 24
Width = 24
Picture = graphics\top.bmp
Name = "Vcrtop"
_navbtns
commandbutton _datanav.vcx _cmdtop ��� � � �� % @ . � U /
�� � � � #)�
�� � � �
�� � � � U THIS PARENT BEFORERECORDPOINTERMOVED RECORDPOINTERMOVED ENABLEDISABLEBUTTONS. 4� � � � ��C � � � � � � �� U NERROR CMETHOD NLINE THIS PARENT ERROR Click, �� Error� ��1 � R � � 3 � �1 � � �
) � _base.vcx _data.h>� �$ _datachecker _data.h Pixels graphics\checker.bmp graphics\checker.bmp Class container �PROCEDURE Click
THIS.Parent.BeforeRecordPointerMoved
GO TOP
THIS.Parent.RecordPointerMoved
THIS.Parent.EnableDisableButtons
ENDPROC
PROCEDURE Error
Parameters nError, cMethod, nLine
This.Parent.Error(nError, cMethod, nLine)
ENDPROC
�Top = 0
Left = 0
Height = 24
Width = 26
FontBold = .T.
FontName = "Courier New"
FontSize = 11
Caption = "|<"
TabIndex = 1
ToolTipText = "Top"
Name = "cmdTop"
�skiptable The table to move the record pointer in .
enabledisableoninit Whether to enable/disable buttons when first loaded.
*recordpointermoved Called each time the record pointer is moved, basically providing a new event for the class.
*enabledisablebuttons Enables/disables buttons based on record pointer location.
*beforerecordpointermoved Called before record pointer is moved.
�PROCEDURE refreshform
IF NOT EMPTY(this.ManyAlias) AND NOT EMPTY(this.ManyKey)
THIS.UpdateMany() &&special handling for 1-Many side if needed.
ENDIF
DO CASE
CASE TYPE('thisformset')=='O'
thisformset.Refresh()
CASE TYPE('_screen.ActiveForm')=='O'
_screen.ActiveForm.Refresh()
ENDCASE
SELECT (this.LastSelect)
RETURN
ENDPROC
PROCEDURE setsession
IF TYPE('_screen.ActiveForm')#'O'
RETURN .F.
ENDIF
IF NOT TYPE('thisformset')=='O'
*** SET SESSION TO (_screen.ActiveForm.DataSessionID)
ENDIF
this.LastSelect=SELECT()
IF NOT EMPTY(this.TableAlias)
IF NOT USED(this.TableAlias)
RETURN .F.
ENDIF
SELECT (this.TableAlias)
ENDIF
IF NOT USED()
RETURN .F.
ENDIF
ENDPROC
@�� ' ' �� % � � � � U V �� � T� � �� � �� T� � �� � �� T� � �� � �� T� � �� � �� U OBTN
LASTSELECT THIS
TABLEALIAS MANYALIAS MANYKEY} ��C� � � � �� ��C� � � � �� ��C� � � � �� ��C� � � � �� %�C� thisformb� O��v � T� � �a�� � U THIS
SETDEFAULT VCRTOP VCRPREVIOUS VCRNEXT VCRBOTTOM THISFORM SHOWTIPS
setdefault, �� Init� ��1 q 11112 1111�� A 3 � � y ) ' �PROCEDURE setdefault
LPARAMETERS oBtn
oBtn.LastSelect=this.LastSelect
oBtn.TableAlias=this.TableAlias
oBtn.ManyAlias=this.ManyAlias
oBtn.ManyKey=this.ManyKey
ENDPROC
PROCEDURE Init
this.SetDefault(this.VCRTop)
this.SetDefault(this.VCRPrevious)
this.SetDefault(this.VCRNext)
this.SetDefault(this.VCRBottom)
IF TYPE('thisform')=='O'
thisform.ShowTips=.T.
ENDIF
ENDPROC
manages conflicts _custom _datachecker 0Height = 15
Width = 23
Name = "_datachecker"
custom _base.vcx _base.vcx "Arial, 0, 10, 6, 16, 13, 23, 3, 0
1
commandbutton _datanav.vcx
_cmdnavbtn _datanav.vcx _base.vcx container
_cmdnavbtn 1Width = 48
Height = 25
Name = "_basicnavbtns"
llastselect Last selected work area.
tablealias Alias of workarea.
manyalias Alias
manykey
*setdefault
�Width = 97
Height = 25
BackStyle = 0
BorderWidth = 0
lastselect = 1
tablealias =
manyalias =
manykey =
builder = vcrtlbrb.scx
Name = "_navbtns"
�lastselect Last selected alias.
tablealias Table alias to move record pointer.
manyalias Alias of child table in 1-Many form.
manykey Key of child table in 1-Many form.
*setdefault
��� � � � %
E � � U 6 # %�C� _VFP.ActiveFormb� O��/ � ��C� � � � U
ACTIVEFORM REFRESHX �� � � � %�CC�� C+ ��? � ��C� Enabled-� � �� B� � T� �CO�� #)� T� �CO�� #6� T� �CO�� #�� ��
H�� �Q� �� � ��� � T� � � �-�� T� � � �-�� T� � � �a�� T� � � �a�� �� � ��1� T� � � �a�� T� � � �a�� T� � � �-�� T� � � �-�� 2�Q� ��C� Enableda� � �� � U
NREC NTOP NBOTTOM THIS SETALL CMDTOP ENABLED CMDPRIOR CMDNEXT CMDBOTTOM' %�C� � �
�� �
F�� � �� � U THIS SKIPTABLE� 4� � � � �� � � � �
H�/ ��� �� �
��� �) T� �C� DBF�
Select Table:� Open��� %�C� 0��� � F� �
Q�� �� T� � �C�� �� � T� � �� �� � �� �1��� T� �C� � �
�� %�� ���� R,��
Data Conflict�� � 2���f T� �� Error Number: CC� Z�C�
C�
� Error Message: CEC�
C�
� Procedure: C�t�� T� �C� �2�x��
H����� �� ����� � �� ����� X� 2��� B� � � U NERROR CMETHOD NLINE CNEWTABLE NCONFLICTSTATUS LCMSG LNANSWER THIS SKIPTABLE DATACHECKER1 CHECKCONFLICTS! %�� � �� �
�� � � � U THIS ENABLEDISABLEONINIT ENABLEDISABLEBUTTONS recordpointermoved, �� enabledisablebuttons{ �� beforerecordpointermoved) �� Errore �� Init� ��1 1� A 3 � A�A A � Q � Q � � � � �A 2 1� A 3 � 2� �� � � � � A !DqA � fA� A A � A A A 3 � A 1 a � � � 3 $ # O � * A O Y ) � �� � � �X % U �
w � U V �� � T� � �� � �� T� � �� � �� T� � �� � �� T� � �� � �� U OBTN
LASTSELECT THIS
TABLEALIAS MANYALIAS MANYKEYW ��C� � � � �� ��C� � � � �� %�C� thisformb� O��P � T� � �a�� � U THIS
SETDEFAULT VCRPREVIOUS VCRNEXT THISFORM SHOWTIPS
setdefault, �� Init� ��1 q 11113 11�� A 2 � � : ) � _cmdnext
_cmdnavbtn Vcrprevious graphics\next.bmp graphics\next.bmp �*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.
Abstract VCR command button. Class _commandbutton
_cmdnavbtn �tablealias Table alias to move record pointer.
manyalias Alias of child table in 1-Many form.
manykey Key of child table in 1-Many form.
lastselect Last selected alias.
*refreshform Refreshes current form.
*setsession
*updatemany
�Height = 24
Width = 29
FontSize = 10
Caption = ""
ForeColor = 0,0,0
tablealias =
manyalias =
manykey =
lastselect = 1
Name = "_cmdnavbtn"
commandbutton _base.vcx Pixels "Arial, 0, 10, 6, 16, 13, 23, 3, 0
_basicnavbtns graphics\vcr.bmp Class _cmdtop 1 graphics\vcr.bmp Class
_container Vcrnext Pixels _cmdprevious "Arial, 0, 10, 6, 16, 13, 14, 3, 0
_datanav.vcx graphics\top.bmp VCR Top.
_cmdnavbtn _cmdtop
commandbutton Pixels
commandbutton
_cmdbottom nPROCEDURE Click
IF NOT this.SetSession()
RETURN .F.
ENDIF
GO TOP
this.RefreshForm()
RETURN
ENDPROC
_datanav.vcx Class Class dHeight = 24
Width = 29
Picture = graphics\bottom.bmp
ToolTipText = "Bottom"
Name = "vcrbottom"
graphics\bottom.bmp xHeight = 24
Width = 29
Picture = graphics\top.bmp
Caption = ""
TabIndex = 1
ToolTipText = "Top"
Name = "_cmdtop"
"Arial, 0, 10, 6, 16, 13, 14, 3, 0
qPROCEDURE Click
IF NOT this.SetSession()
RETURN .F.
ENDIF
GO BOTTOM
this.RefreshForm()
RETURN
ENDPROC
graphics\bottom.bmp Pixels _cmdprevious graphics\previous.bmp _cmdnext
_cmdbottom "Arial, 0, 10, 6, 16, 13, 14, 3, 0
graphics\top.bmp _Height = 24
Width = 29
Picture = graphics\next.bmp
ToolTipText = "Next"
Name = "_cmdnext"
_datanav.vcx
commandbutton cTop = 0
Left = 0
Height = 24
Width = 24
Picture = graphics\previous.bmp
Name = "Vcrprevious"
graphics\previous.bmp
_cmdnavbtn _cmdprevious Class
_basicnavbtns \Top = 0
Left = 24
Height = 24
Width = 24
Picture = graphics\next.bmp
Name = "Vcrnext"
_basicnavbtns
commandbutton _cmdnext
_basicnavbtns �PROCEDURE Click
IF NOT this.SetSession()
RETURN .F.
ENDIF
IF NOT BOF()
SKIP -1
ENDIF
this.RefreshForm()
RETURN
ENDPROC
kHeight = 24
Width = 29
Picture = graphics\previous.bmp
ToolTipText = "Previous"
Name = "_cmdprevious"
commandbutton _datanav.vcx "Arial, 0, 10, 6, 16, 13, 14, 3, 0
Pixels �PROCEDURE Click
IF NOT this.SetSession()
RETURN .F.
ENDIF
IF NOT EOF()
SKIP
ENDIF
IF EOF()
SKIP -1
ENDIF
this.RefreshForm()
RETURN
ENDPROC
�� � � "R % � � � � U 6 %�C� �
�� � B�-�� � #6�
��C� � �� B� U THIS
SETSESSION REFRESHFORM Click, ��1 !q A Q � A 2 f ) � EPROCEDURE setdefault
LPARAMETERS oBtn
oBtn.LastSelect=this.LastSelect
oBtn.TableAlias=this.TableAlias
oBtn.ManyAlias=this.ManyAlias
oBtn.ManyKey=this.ManyKey
ENDPROC
PROCEDURE Init
this.SetDefault(this.VCRPrevious)
this.SetDefault(this.VCRNext)
IF TYPE('thisform')=='O'
thisform.ShowTips=.T.
ENDIF
ENDPROC
�� � � � % � G � U � %�C� � �
�
C� � �
��- �
��C� � �� �
H�> �� � �C� thisformsetb� O��j �
��C� � ��& �C� _screen.ActiveFormb� O��� � ��C�9� � �� �
F�� � �� B� U THIS MANYALIAS MANYKEY
UPDATEMANY THISFORMSET REFRESH
ACTIVEFORM
LASTSELECT� & %�C� _screen.ActiveFormb� O��- � B�-�� � %�C� thisformsetb� O
��Q � � T� � �CW�� %�C� � �
��� � %�C� � �
��� � B�-�� �
F�� � �� �
%�C�
��� � B�-�� � U THIS
LASTSELECT
TABLEALIAS refreshform, ��
setsession; ��1 � A � �� a� A � A 3 aq A B � 11q A � A � q A 2 N
o � ) � �� � � �f % � # �
� U O �� � %�C� m.lnScopeb� N��3 � T�
� �� �� � %�C�
� � ��
��� �> R,��4 Invalid 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�� �� � U LNSCOPE LNCHOICE LNFIELD LCFIELD LUOLDVAL LUCURVAL LUFIELD LLMADECHANGE LLSUCCESS THIS STRING' �� � �� � T�
� �C� m.luValueb��
H�5 � � ��
� � C��V �
B�C�
� ��� �C�
� � N� Y���~ � B�CC�
� Z��� ��
� � D��� �
B�C�
� *�� ��
� � T��� � B�C� m.luValue�� ��
� � L��� � B�C�
� � � .T.� � .F.6�� �� � M�� � B��
Memo field�� � U LUVALUE UTYPE� �� � � �
T�
� �-�� T�
� �� ��
H�8 �� �! �CC� Buffering������ � %�� 2C������| �
T�
� �a�� �! �CC� Buffering������ � %�C� � ��� �
T�
� �a�� � 2�� � R,:�� �� � %��
� ��y�E T�
� �C�! Do you want to save your changes?�$� Save Changes�x�� %��
� ���c� T�
� �CCaa�� �� �6�� �u�
��Ca�� � � B��
� �� U LNCHOICE 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 LNSUCCESS LNREC THIS 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 LNSUCCESS LLNREC THIS HANDLERECORD
NOBUFF_LOC handlerecord, �� string� ��
verifychanges# �� verifyeachchange� �� checkconflictsH ��1 �� A ��A 2� � �� A �� 2aA A AA� 2Q� V A 21A� �A A � 1A1AA A � �� � A 3 z q �� A� �� A� AQA�!1A 2 � � � � a� A A� A � � A � Q1�� � A A � 2 � � � aaA !A� �AA � � A � 2 � � � aaA !A� �AA � � A � 1 : 1 W � Z C � � w \ " � � o � � ) � 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)
WAIT WINDOW WINDMSG_LOC
ENDIF
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
LOCAL uType
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
*---------------------------------------------------------------*
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
*---------------------------------------------------------------*
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
*---------------------------------------------------------------*
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
ZPROCEDURE recordpointermoved
IF TYPE('_VFP.ActiveForm') = 'O'
_VFP.ActiveForm.Refresh
ENDIF
ENDPROC
PROCEDURE enabledisablebuttons
LOCAL nRec, nTop, nBottom
IF EMPTY(ALIAS()) OR 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 Error
Parameters nError, cMethod, nLine
LOCAL cNewTable, nConflictStatus, lcMsg, lnAnswer
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
PROCEDURE Init
IF THIS.EnableDisableOnInit
THIS.EnableDisableButtons
ENDIF
ENDPROC