Специализированный программный продукт по работе со счетами-фактуры

SET deleted off

this.Parent.grid1.DeleteMark=.T.

thisform.Refresh

ELSE

SET deleted on

this.Parent.grid1.DeleteMark=.F.

thisform.Refresh

ENDIF

ENDPROC

PROCEDURE AfterRowColChange

LPARAMETERS nColIndex

thisform.Refresh

ENDPROC

PROCEDURE Click

SET order to код

this.Parent.Parent.Refresh()

ENDPROC

PROCEDURE Click

SET order to наименован

this.Parent.Parent.Refresh()

ENDPROC

PROCEDURE Click

IF This.Value=0

SET deleted off

this.Parent.grid1.DeleteMark=.T.

thisform.Refresh

ELSE

SET deleted on

this.Parent.grid1.DeleteMark=.F.

thisform.Refresh

ENDIF

ENDPROC

PROCEDURE AfterRowColChange

LPARAMETERS nColIndex

thisform.Refresh

ENDPROC

PROCEDURE Click

SET order to код

this.Parent.Parent.Refresh()

ENDPROC

PROCEDURE Click

SET order to наименован

this.Parent.Parent.Refresh()

ENDPROC

PROCEDURE Click

IF This.Value=0

SET deleted off

this.Parent.grid1.DeleteMark=.T.

thisform.Refresh

ELSE

SET deleted on

this.Parent.grid1.DeleteMark=.F.

thisform.Refresh

ENDIF

ENDPROC

PROCEDURE setallprop

LPARAMETER oContainer

* Checks for General fields

LOCAL i,oControlParent,nCtrlCount

IF PARAMETERS() = 0

m.oControlParent = THISFORM

ELSE

m.oControlParent = m.oContainer

ENDIF

DO CASE

CASE ATC("Pageframe",m.oControlParent.BaseClass)#0

nCtrlCount = oControlParent.PageCount

CASE ATC(m.oControlParent.BaseClass,"Optiongroup,Commandgroup")#0

nCtrlCount = oControlParent.ButtonCount

OTHERWISE

nCtrlCount = oControlParent.ControlCount

ENDCASE

FOR i = 1 TO m.nCtrlCount

DO CASE

CASE ATC("Pageframe",m.oControlParent.BaseClass)#0

this.setallprop(m.oControlParent.Pages[m.i])

CASE ATC(m.oControlParent.BaseClass,"Optiongroup,Commandgroup")#0 AND ;

THIS.UserControlMode

m.oControlParent.Buttons[m.i].Enabled = THIS.EditMode

CASE ATC(m.oControlParent.Controls[m.i].BaseClass,"Optiongroup,Commandgroup")#0 ;

AND THIS.UserControlMode

this.setallprop(m.oControlParent.Controls[m.i])

CASE ATC("Container",m.oControlParent.Controls[m.i].BaseClass) # 0 OR;

ATC("Page",m.oControlParent.Controls[m.i].BaseClass) # 0

this.setallprop(m.oControlParent.Controls[m.i])

CASE ATC(m.oControlParent.Controls[m.i].BaseClass,"ListBox,ComboBox,Spinner") # 0 &∧

&&THIS.UserControlMode

m.oControlParent.Controls[m.i].Enabled = THIS.EditMode

CASE ATC(m.oControlParent.Controls[m.i].BaseClass,"CheckBox,TextBox,OleBoundControl") # 0

m.oControlParent.Controls[m.i].Enabled = THIS.EditMode

CASE ATC(m.oControlParent.Controls[m.i].BaseClass,"EditBox,TextBox") # 0

m.oControlParent.Controls[m.i].ReadOnly = !THIS.EditMode

IF !THIS.HasMemo

WITH m.oControlParent.Controls[m.i]

this.EditForeColor = .ForeColor

this.EditDisForeColor = .DisabledForeColor

this.EditBackColor = .BackColor

this.EditDisBackColor = .DisabledBackColor

this.HasMemo = .T.

ENDWITH

ENDIF

m.oControlParent.Controls[m.i].ForeColor = IIF(THIS.EditMode,THIS.EditForeColor,THIS.EditDisForeColor)

m.oControlParent.Controls[m.i].BackColor = IIF(THIS.EditMode,THIS.EditBackColor,THIS.EditDisBackColor)

CASE ATC(m.oControlParent.Controls[m.i].BaseClass,"Grid") # 0

m.oControlParent.Controls[m.i].ReadOnly = !THIS.EditMode

*m.oControlParent.Controls[m.i].DeleteMark = THIS.EditMode

ENDCASE

ENDFOR

ENDPROC

PROCEDURE cmdAdd.Click

IF ThisForm.Pageframe1.ActivePage=1

IF this.parent.EditMode

fl=0

fl2=recno()

fl4=iif(isnull(oldval("инн","f_sprpp")),0,oldval("инн","f_sprpp"))

LOCATE for f_sprpp.инн=ThisForm.Pageframe1.Page1.инн1.value

DO while found()

fl=fl+1

CONTINUE

ENDDO

IF fl#1

GO fl2

REPLACE инн with fl4

thisform.Pageframe1.Page1.инн1.value=fl4

TABLEUPDATE(.f.)

MESSAGEBOX("Фирма с таким инн уже существует",16,"Ошибка")

this.Parent.cmdEdit.Enabled=.f.

thisform.Pageframe1.Page1.инн1.SetFocus

RETURN

ELSE

DoDefault()

thisform.Pageframe1.Page1.grid1.Enabled=.t.

ENDIF

IF fl2=-1

GO bottom

ELSE

GO fl2

ENDIF

ELSE

DoDefault()

thisform.Pageframe1.Page1.grid1.Enabled=.f.

thisform.Pageframe1.Page1.КОд_id1.Enabled=.f.

thisform.Pageframe1.Page1.инн1.SetFocus()

ENDIF

ELSE

IF ThisForm.Pageframe1.ActivePage=2

IF This.Parent.EditMode

thisform.Pageframe1.Page2.grid1.Column3.Combo1.Enabled=.f.

ELSE

thisform.Pageframe1.Page2.grid1.Column3.Combo1.Enabled=.t.

ENDIF

ENDIF

DoDefault()

IF This.Parent.EditMode=.f.

zxxz="ThisForm.Pageframe1.Page"+alltrim(str(ThisForm.Pageframe1.ActivePage))+".Grid1.ReadOnly=.t."

ELSE

zxxz="ThisForm.Pageframe1.Page"+alltrim(str(ThisForm.Pageframe1.ActivePage))+".Grid1.ReadOnly=.f."

ENDIF

&zxxz

zxxz="ThisForm.Pageframe1.Page"+alltrim(str(ThisForm.Pageframe1.ActivePage))+".Grid1.Column1.Enabled=.f."

IF ThisForm.Pageframe1.ActivePage=5

zxxz="ThisForm.Pageframe1.Page5.Grid1.Column1.Enabled=.t."

ENDIF

&zxxz

zxxz="ThisForm.Pageframe1.Page"+alltrim(str(ThisForm.Pageframe1.ActivePage))+".Grid1.Column2.Text1.SetFocus()"

IF ThisForm.Pageframe1.ActivePage=5

zxxz="ThisForm.Pageframe1.Page5.Grid1.Column1.Text1.SetFocus()"

ENDIF

&zxxz

ENDIF

ENDPROC

PROCEDURE cmdDelete.Click

#DEFINE MSGBOX_YES6

#DEFINE C_MSGBOX136

#DEFINE C_DELETE_LOC"Вы хотите удалить эту запись?"

#DEFINE C_NOLOCK_LOC"Запись не может быть удалена, так как используется."

* Note: Cascading deletes should be handled via RI triggers in DBC!

IF DELETED()

RECALL

IF THIS.Parent.UpdateRows() &&success

* Success

IF !EOF()

Skip 1

ENDIF

IF EOF() AND !BOF()

Skip -1

ENDIF

ENDIF

thisform.LockScreen = .T.

this.Parent.ButtonRefresh()

this.Parent.NavRefresh()

thisform.LockScreen = .F.

ELSE

IF MESSAGEBOX(C_DELETE_LOC,C_MSGBOX1) = MSGBOX_YES

Delete

IF THIS.Parent.UpdateRows() &&success

* Success

IF !EOF()

Skip 1

ENDIF

IF EOF() AND !BOF()

Skip -1

ENDIF

ENDIF

thisform.LockScreen = .T.

this.Parent.ButtonRefresh()

this.Parent.NavRefresh()

thisform.LockScreen = .F.

ENDIF

ENDIF

IF THISFORM.ShowWindow = 2

Activate Window (THISFORM.Name)

ENDIF

ENDPROC

PROCEDURE cmdEdit.Click

IF ThisForm.Pageframe1.ActivePage=2

IF This.Parent.EditMode

thisform.Pageframe1.Page2.grid1.Column3.Combo1.Enabled=.f.

ELSE

thisform.Pageframe1.Page2.grid1.Column3.Combo1.Enabled=.t.

ENDIF

ENDIF

DoDefault()

IF ThisForm.Pageframe1.ActivePage=1

IF This.Parent.EditMode=.f.

thisform.Pageframe1.Page1.grid1.Enabled=.t.

ELSE

thisform.Pageframe1.Page1.grid1.Enabled=.F.

thisform.Pageframe1.Page1.КОд_id1.Enabled=.f.

thisform.Pageframe1.Page1.инн1.SetFocus()

ENDIF

ELSE

IF This.Parent.EditMode=.f.

zxxz="ThisForm.Pageframe1.Page"+alltrim(str(ThisForm.Pageframe1.ActivePage))+".Grid1.ReadOnly=.t."

ELSE

zxxz="ThisForm.Pageframe1.Page"+alltrim(str(ThisForm.Pageframe1.ActivePage))+".Grid1.ReadOnly=.f."

ENDIF

&zxxz

zxxz="ThisForm.Pageframe1.Page"+alltrim(str(ThisForm.Pageframe1.ActivePage))+".Grid1.Column1.Enabled=.f."

IF ThisForm.Pageframe1.ActivePage=5

zxxz="ThisForm.Pageframe1.Page5.Grid1.Column1.Enabled=.t."

ENDIF

&zxxz

zxxz="ThisForm.Pageframe1.Page"+alltrim(str(ThisForm.Pageframe1.ActivePage))+".Grid1.Column2.Text1.SetFocus()"

IF ThisForm.Pageframe1.ActivePage=5

zxxz="ThisForm.Pageframe1.Page5.Grid1.Column1.Text1.SetFocus()"

ENDIF

&zxxz

ENDIF

ENDPROC

****** * WIZSTYLE.VCX

PROCEDURE Init

LPARAMETERS cFldKey,cKeyValue,nBtnAction,nAddAction,lChildPrimaryKey,lUpdatableParentKey,lNoSendUpdates

IF PARAMETERS() # 7

RETURN .F.

ENDIF

this.CommandGroup1.Value = 0

this.Label3.Caption = m.cFldKey

this.cKeyValue = m.cKeyValue

DO CASE

CASE m.lNoSendUpdates

* Send Parent Updates

this.Optiongroup1.Option1.Enabled = .F.

this.Optiongroup1.Option3.Enabled = .F.

CASE !m.lUpdatableParentKey

* Updatable parent key

this.Optiongroup1.Option3.Enabled = .F.

ENDCASE

* Has a primary key

IF m.lChildPrimaryKey

this.Optiongroup1.Option2.Enabled = .F.

ENDIF

DO CASE

CASE TYPE('THIS.cKeyValue') = "C"

this.Text1.Value = ""

CASE ATC(TYPE('THIS.cKeyValue'),"NYIBF") # 0

this.Text1.Value = 0

CASE ATC(TYPE('THIS.cKeyValue'),"DT") # 0

this.Text1.Value = {//}

CASE TYPE('THIS.cKeyValue') = "L"

this.Text1.Value = .T.

ENDCASE

ENDPROC

PROCEDURE InteractiveChange

DO CASE

CASE THIS.Value = 2

thisform.Text1.Value = THISFORM.cKeyValue

CASE TYPE('THISFORM.cKeyValue') = "C"

thisform.Text1.Value = ""

CASE ATC(TYPE('THISFORM.cKeyValue'),"NYIBF") # 0

thisform.Text1.Value = 0

CASE ATC(TYPE('THISFORM.cKeyValue'),"DT") # 0

thisform.Text1.Value = {//}

CASE TYPE('THISFORM.cKeyValue') = "L"

thisform.Text1.Value = .T.

ENDCASE

thisform.Text1.ReadOnly = (THIS.Value = 2)

ENDPROC

PROCEDURE Click

cKeyValue = THIS.Parent.Text1.Value

nAddAction = THIS.Parent.Optiongroup1.Value

nBtnAction = THIS.Value

thisform.Release()

ENDPROC

PROCEDURE runaddform

#DEFINE C_NOOBJ_LOC"Failed to create the Add Record form class. Check or reinstall the WIZSTYLE.VCX file."

PRIVATE cFldKey,cKeyValue,nBtnAction,nAddAction,oGridAddForm

IF TYPE("THIS.KeyField") # "C"

this.KeyField = ""

ENDIF

cFldKey = THIS.KeyField

cKeyValue = THIS.KeyValue

nBtnAction = 1

nAddAction = 1

oGridAddForm = CREATE("gridaddform",m.cFldKey,m.cKeyValue,;

m.nBtnAction,m.nAddAction,THIS.ChildPrimaryKey,THIS.UpdatableParentKey,THIS.NoSendUpdates)

IF TYPE("m.oGridAddForm") # "O"

=MESSAGEBOX(C_NOOBJ_LOC)

this.AddOption = 0

RETURN

ENDIF

IF THIS.NoSendUpdates

oGridAddForm.Optiongroup1.Value = 2

oGridAddForm.Text1.Value = m.cKeyValue

ENDIF

oGridAddForm.Show()

this.AddOption = IIF(m.nBtnAction=1,m.nAddAction,0)

this.KeyValue = m.cKeyValue

ENDPROC

PROCEDURE Init

TxtBtns::Init()

thisform.ShowTips = .T.

ENDPROC

PROCEDURE setcaption

IF !THIS.EditMode

this.cmdAdd.Picture = THIS.wizbmppath+"wznew.bmp"

this.cmdEdit.Picture = THIS.wizbmppath+"wzedit.bmp"

this.cmdAdd.DownPicture = THIS.wizbmppath+"wznew.bmp"

this.cmdEdit.DownPicture = THIS.wizbmppath+"wzedit.bmp"

ELSE

this.cmdAdd.Picture = THIS.wizbmppath+"wzsave.bmp"

this.cmdEdit.Picture = THIS.wizbmppath+"wzundo.bmp"

this.cmdAdd.DownPicture = THIS.wizbmppath+"wzsave.bmp"

this.cmdEdit.DownPicture = THIS.wizbmppath+"wzundo.bmp"

ENDIF

ENDPROC

PROCEDURE initvars

#DEFINE C_NOUPDATEVIEW_LOC"Edits to one or more of the Views may not be permanent. "+;

"To remedy this, ensure the View's Send SQL Updates checkbox is checked in the View Designer."

#DEFINE C_READONLY_LOC"The table is Read-Only. You will not be able to edit it."

LOCAL aTablesUsed,nTablesUsed,i,aMems,nTotMem,cWizFile,lShowedMess,cDataEnvRef

DIMENSION aTablesUsed[1]

DIMENSION aMems[1]

this.nWorkArea = SELECT()

this.oldSetDelete = SET("DELETED")

SET DELETED ON

this.oldreprocess = SET("REPROCESS")

SET REPROCESS TO 0

* These properties should not be used. They are reserved for use by

* the Preview button of the Form Wizards.

this.previewmode = IIF(TYPE("THIS.PreviewMode")#"L",.F.,THIS.previewmode)

this.previewinit = IIF(TYPE("THIS.PreviewInit")#"L",.T.,THIS.previewinit)

* Check for data environment

DO CASE

CASE TYPE("THISFORM.DataEnvironment") = "O"

this.usedataenv = .T.

nTotMem = AMEMBERS(aMems,THISFORM.DataEnvironment,2)

cDataEnvRef = "THISFORM.DataEnvironment"

CASE TYPE("THISFORMSET.DataEnvironment") = "O"

this.usedataenv = .T.

nTotMem = AMEMBERS(aMems,THISFORMSET.DataEnvironment,2)

cDataEnvRef = "THISFORMSET.DataEnvironment"

* let's also set the

IF TYPE("THISFORM")="O" AND !THISFORM.VISIBLE

thisform.VISIBLE = .T.

ENDIF

OTHERWISE

this.usedataenv = .F.

ENDCASE

IF THIS.usedataenv

WITH EVAL(m.cDataEnvRef)

* Check for Views

FOR i = 1 TO m.nTotMem

IF UPPER(EVAL("."+aMems[m.i]+".BaseClass")) = "CURSOR"

WITH EVAL("."+aMems[m.i])

IF CURSORGETPROP("SourceType",.Alias)#3

* Check if we need to requery for deleted records.

* -- Note: Parameterized views are not requeried so all records will be brought over.

* To remedy this situation you can place a SET DELETED ON command in the

* BeforeOpenTables event of the DataEnvironment.

IF THIS.oldSetDelete = "OFF" AND ATC("?",CURSORGETPROP("SQL",.Alias))=0

=REQUERY(.Alias)

ENDIF

* Check if updates are made

IF !CURSORGETPROP("SendUpdates",.Alias) AND !m.lShowedMess

=MESSAGEBOX(C_NOUPDATEVIEW_LOC)

lShowedMess = .T.

ENDIF

ENDIF

ENDWITH

ENDIF

ENDFOR

ENDWITH

ENDIF

IF ISREADONLY()

WAIT WINDOW C_READONLY_LOC TIMEOUT 2

ENDIF

* Disable appropriate buttons

this.cmdAdd.Enabled = !ISREADONLY()

this.cmdDelete.Enabled = !ISREADONLY()

IF THIS.previewmode

RETURN

ENDIF

IF THIS.usedataenv

RETURN

ENDIF

* The following code is here to support forms not using a DataEnvironment.

this.oldSetFields = SET("FIELDS")

SET FIELDS OFF

this.oldMultiLocks = SET("MULTILOCKS")

SET MULTILOCKS ON

this.oldrefresh = SET("REFRESH")

SET REFRESH TO 5

IF !EMPTY(ALIAS())

this.oldBuffering=CursorGetProp("buffering")

m.nTablesUsed = AUSED(aTablesUsed)

FOR i = 1 TO m.nTablesUsed

IF CursorGetProp('sourcetype',aTablesUsed[m.i,1])#3&&skip for views

=CursorSetProp("buffering",5,aTablesUsed[m.i,1])&&optimistic table buffering

ENDIF

ENDFOR

ENDIF

GO TOP

ENDPROC

PROCEDURE UpdateRows

#DEFINEE_FAIL_LOC"Failed to update table: "

#DEFINEE_TRIGGERFAIL_LOC"Trigger failed."

#DEFINEE_FIELDNULL_LOC"Field doesn't accept NULL"

#DEFINEE_FIELDRULE_LOC"Field rule violated"

#DEFINEE_RECORDLOCK_LOC"Record in use by another user"

#DEFINEE_ROWRULE_LOC"Row rule violated"

#DEFINEE_UNIQUEINDEX_LOC"Unique index violation"

#DEFINEE_DIRTYREC_LOC"Data has been changed by another user. Overwrite changes with your edits?"

#DEFINEE_NOFORCE_LOC"Could not force table updates."

#DEFINE E_PROMPT_LOC "Error: "

#DEFINE MSGBOX_YES6

LOCAL aErrors,cErrorMessage,aTablesUsed,nTablesUsed,nTotErr

LOCAL nFld,i,nOldArea,lSuccess,lInDBC,lOverwrite,lHadMessage

DIMENSION aTablesUsed[1]

DIMENSION aErrors[1]

m.cErrorMessage=""

m.lSuccess = .T.

m.nOldArea = SELECT()

m.nTablesUsed = AUSED(aTablesUsed)

* Can wrap everything in transaction if using strictly DBCs

FOR i = 1 TO m.nTablesUsed

SELECT (aTablesUsed[m.i,1])

m.lInDBC = !EMPTY(CURSORGETPROP("Database"))

m.cErrorMessage = ""

m.lOverwrite = .F.

m.lHadMessage = .F.

DO CASE

CASE CURSORGETPROP("Buffering") = 1

* Skip if buffering not on

LOOP

CASE GetFldState(0) = 2&&deleted record

* Only delete current record and force it

m.lSuccess = TableUpdate(.F.,.T.)

IF m.lSuccess&&successful update

LOOP

ENDIF

CASE !m.lInDBC AND (ATC("2",GetFldState(-1))#0 OR;

ATC("3",GetFldState(-1))#0)

* Field was edited - in Free Table

* Since free tables are not supported by transactions,

* we must process record by record

m.nModRecord = GetNextMod(0)

DO WHILE m.nModRecord # 0&&loop locks all records

GO m.nModRecord

m.lSuccess = RLOCK()&&try to lock record

IF !m.lSuccess&&failed to lock record

m.cErrorMessage = E_RECORDLOCK_LOC

UNLOCK ALL

EXIT

ENDIF

IF !m.lHadMessage&&so we don't repeat alert

* See if record(s) modified by another user

FOR m.nFld = 1 TO FCOUNT()

IF TYPE(FIELD(m.nFld)) = "G"&&skip for General fields

LOOP

ENDIF

IF OLDVAL(FIELD(m.nFld)) # CURVAL(FIELD(m.nFld))

m.lHadMessage = .T.

IF MESSAGEBOX(E_DIRTYREC_LOC,4+48) = MSGBOX_YES

m.lOverwrite = .T.

ELSE

m.lSuccess = .F.

UNLOCK ALL

EXIT

ENDIF

ENDIF

ENDFOR

ENDIF

m.nModRecord = GetNextMod(m.nModRecord)

ENDDO

IF m.lSuccess &&was able to lock all records

m.lSuccess = TableUpdate(.T.,m.lOverwrite)

IF m.lSuccess &&was able to update all records

LOOP

ENDIF

UNLOCK ALL

ENDIF

CASE m.lInDBC

BEGIN TRANSACTION

* Try to update all records in selected table

m.lSuccess = TableUpdate(.T.,.F.)&&successful update

IF m.lSuccess

END TRANSACTION

LOOP

ENDIF

ROLLBACK

ENDCASE

* Handle errors

nTotErr =AERROR(aErrors)

DO CASE

CASE nTotErr = 0

CASE aErrors[1,1] = 1539&& Trigger failed

m.cErrorMessage = E_TRIGGERFAIL_LOC

CASE aErrors[1,1] = 1581&& Field doesn't accept NULL

m.cErrorMessage = E_FIELDNULL_LOC

CASE aErrors[1,1] = 1582&& Field rule violated

m.cErrorMessage = E_FIELDRULE_LOC

CASE aErrors[1,1] = 1700&& Record in use by another user

m.cErrorMessage = E_RECORDLOCK_LOC

CASE aErrors[1,1] = 1583&& Row rule violated

m.cErrorMessage = E_ROWRULE_LOC

CASE aErrors[1,1] = 1884&& Unique index violation

m.cErrorMessage = E_UNIQUEINDEX_LOC

CASE aErrors[1,1] = 1585&& Record changed by another user

IF m.lInDBC&&handle free tables above

* Dislpay conflict alert

IF MESSAGEBOX(E_DIRTYREC_LOC,4+48) = MSGBOX_YES

*Try to force update

BEGIN TRANSACTION

m.lSuccess = TABLEUPDATE(.T.,.T.)

IF m.lSuccess

END TRANSACTION

LOOP

ELSE

ROLLBACK

=MESSAGEBOX(E_NOFORCE_LOC)

ENDIF

ENDIF

ENDIF

OTHERWISE

IF !EMPTY(m.cErrorMessage)&&for free table handling above

m.cErrorMessage = E_PROMPT_LOC+aErrors[1,2]

ENDIF

ENDCASE

* Had an error we couldn't handle

=TABLEREVERT(.T.) &&revert all records

m.lSuccess = .F.

IF !EMPTY(m.cErrorMessage)

=MESSAGEBOX(E_FAIL_LOC+m.cErrorMessage)

ENDIF

ENDFOR

SELECT (m.nOldArea)

RETURN m.lSuccess

ENDPROC

PROCEDURE Refresh

**** Special Preview Mode Handling ****

IF THIS.previewmode AND THIS.previewinit

this.previewinit = .F.

this.cmdAdd.Enabled = .F.

this.cmdDelete.Enabled = .F.

this.cmdFind.Enabled = .F.

this.cmdPrint.Enabled = .F.

this.cmdExit.Enabled = .F.

this.nWorkArea = SELECT()

ENDIF

ENDPROC

PROCEDURE Init

#DEFINE C_WIZSTYLE"WIZSTYLE.VCX"

#DEFINE C_WIZDIR "WIZARDS\"

#DEFINE C_PROMPT1_LOC"Find: "

#DEFINE E_NOSTYLE_LOC"The class library (WIZSTYLE.VCX) needed by this form could not be found. "+;

"Please locate."

LOCAL cWizHomePath,separator,cWizStyFile

IF TYPE('THIS.Parent') # "O"

RETURN

ENDIF

IF SET("TALK") = "ON"

SET TALK OFF

this.oldTalk = "ON"

ELSE

this.oldTalk = "OFF"

ENDIF

IF ATC(C_WIZSTYLE,SET("CLASSLIB")) = 0

* Returns just the pathname

cWizHomePath = _WIZARD

IF '\' $ cWizHomePath

cWizHomePath = SUBSTR(m.cWizHomePath,1,RAT('\',m.cWizHomePath))

IF RIGHT(m.cWizHomePath,1) = '\' AND LEN(m.cWizHomePath) > 1 ;

AND SUBSTR(m.cWizHomePath,LEN(m.cWizHomePath)-1,1) <> ':'

cWizHomePath = SUBSTR(m.cWizHomePath,1,LEN(m.cWizHomePath)-1)

ENDIF

ELSE

cWizHomePath = ''

ENDIF

* Add a backslash unless there is one already there.

Separator = IIF(_MAC,":","\")

IF !(RIGHT(m.cWizHomePath,1) $ '\:') AND !EMPTY(m.cWizHomePath)

m.cWizHomePath= m.cWizHomePath+ m.separator

ENDIF

DO CASE

CASE FILE(C_WIZSTYLE)

cWizFile = C_WIZSTYLE

CASE FILE(m.cWizHomePath+C_WIZSTYLE)

cWizFile = m.cWizHomePath+C_WIZSTYLE

CASE FILE(m.cWizHomePath+C_WIZDIR+C_WIZSTYLE)

cWizFile = m.cWizHomePath+C_WIZDIR+C_WIZSTYLE

CASE FILE(HOME()+C_WIZSTYLE)

cWizFile = HOME()+C_WIZSTYLE

CASE FILE(HOME()+C_WIZDIR+C_WIZSTYLE)

cWizFile = HOME()+C_WIZDIR+C_WIZSTYLE

OTHERWISE

=MESSAGEBOX(E_NOSTYLE_LOC)

cWizFile = GETFILE("VCX",C_PROMPT1_LOC+C_WIZSTYLE)

ENDCASE

IF ATC(C_WIZSTYLE,m.cWizFile)#0

SET CLASS TO (m.cWizFile) ADDITIVE

ELSE

* Failed to get WIZSTYLE.VCX file

RETURN .F.

ENDIF

ENDIF

this.initvars()

ENDPROC

PROCEDURE Error

PARAMETERS nError, cMethod, nLine

LOCAL aFoxErr,nTotErr

DIMENSION aFoxErr[1]

nTotErr = AERROR(aFoxErr)

DO CASE

CASE INLIST(m.nError,1733,1734) &&property not found -- traps SETALL()

RETURN

CASE m.nError=1938 &&no parent

RETURN

CASE nTotErr>0 AND aFoxErr[1,1] = 1420

* Corrupt Ole object in General field.

=MESSAGEBOX(aFoxErr[1,2])

RETURN

ENDCASE

**** Error Dialog ******

=MESSAGEBOX(MESSAGE(1)+CHR(13)+;

"Error: "+STR(nError)+CHR(13)+;

MESSAGE()+CHR(13)+;

"Method: "+cMethod+CHR(13)+;

"Line: "+STR(nLine))

RETURN TO MASTER

ENDPROC

PROCEDURE Destroy

* Restore various settings

LOCAL nTablesUsed,aTablesUsed,i,nDECursors,aDECursors,cDataEnvRef

DIMENSION aTablesUsed[1]

IF TYPE('THIS.Parent') # "O"

RETURN

ENDIF

IF TYPE("THIS.oldTalk") = "C" AND THIS.oldTalk="ON"

SET TALK ON

ENDIF

IF THIS.usedataenv

DIMENSION aDECursors[1]

DO CASE

CASE TYPE("THISFORM.DataEnvironment") = "O"

nDECursors = AMEMBERS(aDECursors,THISFORM.DataEnvironment,2)

cDataEnvRef = "THISFORM.DataEnvironment"

CASE TYPE("THISFORMSET.DataEnvironment") = "O"

nDECursors = AMEMBERS(aDECursors,THISFORMSET.DataEnvironment,2)

cDataEnvRef = "THISFORMSET.DataEnvironment"

ENDCASE

FOR i = 1 TO m.nDECursors

WITH EVAL(m.cDataEnvRef + "." + aDECursors[m.i])

IF USED(.ALIAS) AND ATC("CURSOR",.BaseClass)#0 AND ;

CursorGetProp("sourcetype",.ALIAS)=3 AND ;

CursorGetProp("buffering",.ALIAS)>1

=TableRevert(.T.,.ALIAS)

=CursorSetProp("buffering",1,.ALIAS)&&optimistic table buffering

ENDIF

ENDWITH

ENDFOR

ENDIF

* Skip if using preview mode

IF THIS.previewmode

RETURN

ENDIF

IF THIS.oldSetDelete = "OFF"

SET DELETED OFF

ENDIF

SET REPROCESS TO THIS.oldreprocess

SET MESSAGE TO

SELECT (THIS.nWorkArea)

IF THIS.usedataenv

RETURN

ENDIF

m.nTablesUsed = AUSED(aTablesUsed)

FOR i = 1 TO m.nTablesUsed

IF USED(aTablesUsed[m.i,1]) AND ATC(".TMP",DBF(aTablesUsed[m.i,1]))=0&&skip for views

=CursorSetProp("buffering",THIS.oldBuffering,aTablesUsed[m.i,1])&&optimistic table buffering

ENDIF

ENDFOR

IF THIS.oldMultiLocks = "OFF"

SET MULTILOCKS OFF

ENDIF

IF THIS.oldSetFields = "ON"

SET FIELDS ON

ENDIF

SET REFRESH TO THIS.oldrefresh

ENDPROC

PROCEDURE Click

LOCAL lVisChange,lStateChange,oSearchDlog

* Check if SDI Window

IF THISFORM.ShowWindow = 2

IF !_VFP.Visible

_VFP.Visible = .T.

lVisChange = .T.

ENDIF

IF _SCREEN.WindowState = 1

_SCREEN.WindowState = 0

lStateChange = .T.

ENDIF

ENDIF

oSearchDlog = CREATE("searchform")

oSearchDlog.SHOW()

thisform.REFRESH()

IF m.lVisChange

_VFP.Visible = .F.

ENDIF

IF m.lStateChange

_SCREEN.WindowState = 1

ENDIF

IF THISFORM.ShowWindow = 2

Activate Window (THISFORM.Name)

ENDIF

ENDPROC

PROCEDURE Click

#DEFINE C_MAKEREPO_LOC"Could not locate a report to print. Create new one?"

#DEFINE C_NOOPEN_LOC"Error opening table. Unable to print report."

#DEFINE C_GETFILEPROMPT_LOC"Select a report to print:"

LOCAL cRepName,nSaveSess,cSaveAlias,cSaveSource,cSaveData

cSaveAlias = ALIAS()

cSaveSource = CURSORGETPROP("SourceName")

cSaveData = CURSORGETPROP("Database")

cDiffSource = ""

cRepName = LEFT(ALIAS(),8)+".FRX"

nSaveSess = SET("DATASESSION")

#IF 0

* Handling for Private data sessions

IF m.nSaveSess # 1

SET DATASESSION TO 1

SELECT 0

IF !EMPTY(m.cSaveData)

OPEN DATABASE (m.cSaveData)

ENDIF

IF USED(m.cSaveAlias)

SELECT (m.cSaveAlias)

IF CURSORGETPROP("SourceName")#m.cSaveSource

cDiffSource = CURSORGETPROP("SourceName")

USE IN (m.cSaveAlias)

SELECT 0

ENDIF

ENDIF

IF EMPTY(ALIAS())

USE (m.cSaveSource) AGAIN ALIAS (m.cSaveAlias) SHARED

IF EMPTY(ALIAS())

=MESSAGEBOX(C_NOOPEN_LOC)

RETURN

ENDIF

ENDIF

ENDIF

#ENDIF

IF FILE(m.cRepName)

REPORT FORM (m.cRepName) PREVIEW NOWAIT

ELSE

m.cRepName = GETFILE("frx",C_GETFILEPROMPT_LOC,"",1)

IF !EMPTY(m.cRepName)

IF FILE(m.cRepName)

* User pressed Open button

REPORT FORM (m.cRepName) PREVIEW NOWAIT

ELSE

* User pressed New button

DO (_WIZARD) WITH "AUTOREPORT"

ENDIF

ENDIF

ENDIF

#IF 0

IF !EMPTY(cDiffSource)

USE (m.cDiffSource) IN 0

ENDIF

SET DATASESSION TO m.nSaveSess

SELECT (m.cSaveAlias)

#ENDIF

IF THISFORM.ShowWindow = 2

Activate Window (THISFORM.Name)

ENDIF

ENDPROC

PROCEDURE Click

thisform.Release

ENDPROC

PROCEDURE Click

#DEFINE C_NOUPDATE_LOC"You cannot add a new record because the view(s) selected does not send updates."

IF CURSORGETPROP("SourceType")#3 AND !CURSORGETPROP("SendUpdates")

MESSAGEBOX(C_NOUPDATE_LOC)

RETURN

ENDIF

APPEND BLANK

thisform.REFRESH()

ENDPROC

PROCEDURE Click

#DEFINE MSGBOX_YES6

#DEFINE C_MSGBOX136

#DEFINE C_DELETE_LOC"Do you want to delete this record?"

IF MESSAGEBOX(C_DELETE_LOC,C_MSGBOX1) = MSGBOX_YES

Delete

IF THIS.Parent.UpdateRows() &&success

* Success

IF !EOF()

Skip 1

ENDIF

IF EOF() AND !BOF()

Skip -1

ENDIF

ENDIF

ENDIF

thisform.REFRESH()

IF THISFORM.ShowWindow = 2

Activate Window (THISFORM.Name)

ENDIF

ENDPROC

PROCEDURE searchexpr

LOCAL cGetExpr1,cGetExpr2,cJoin,cGetExpr

m.cGetExpr1 = THIS.SearchItem(THIS.cboFields1,THIS.cboOperators1,THIS.txtExpr1)

m.cGetExpr2 = THIS.SearchItem(THIS.cboFields2,THIS.cboOperators2,THIS.txtExpr2)

m.cJoin = IIF(THIS.optGrpAndOr.value = 2," OR "," AND ")

DO CASE

CASE EMPTY(m.cGetExpr1) AND EMPTY(m.cGetExpr2)

m.cGetExpr = ""

CASE EMPTY(m.cGetExpr2)

m.cGetExpr = m.cGetExpr1

CASE EMPTY(m.cGetExpr1)

m.cGetExpr = m.cGetExpr2

OTHERWISE

m.cGetExpr = m.cGetExpr1+m.cJoin+m.cGetExpr2

ENDCASE

RETURN m.cGetExpr

ENDPROC

PROCEDURE dataexpr

LPARAMETER cDataType,cFldExpr

LOCAL cTmpExpr

DO CASE

CASE INLIST(m.cDataType,"M","G","P","O","U")

RETURN ""

CASE m.cDataType = "C"

IF TYPE("'Test'="+m.cFldExpr) # "L"

IF THIS.remotedelimeter

cTmpExpr = '"'+m.cFldExpr+'"'

ELSE

cTmpExpr = "["+m.cFldExpr+"]"

ENDIF

ELSE

cTmpExpr = m.cFldExpr

ENDIF

* Check for case sensitive

IF THIS.chkCaseSensitive.Value = 0

m.cTmpExpr= "UPPER("+m.cTmpExpr+")"

ENDIF

RETURN m.cTmpExpr

CASE INLIST(m.cDataType,"N","F","I","Y","B")

* Check for any commas and remove

RETURN ALLTRIM(STR(VAL(STRTRAN(m.cFldExpr,",")),16,4))

CASE INLIST(m.cDataType,"D","T")

RETURN "{"+CHRTRAN(m.cFldExpr,"{}","")+"}"

OTHERWISE

RETURN ""

ENDCASE

ENDPROC

PROCEDURE SearchItem

LPARAMETERS oField,oOp,oExpr

LOCAL cExpr,cDataType,cOp,cFldName,cFldExpr,cRetExpr,aExprs,nTotExprs,i

* Check to make sure proper parameters passed

IF TYPE("m.oField")#"O" OR TYPE("m.oOp")#"O" OR TYPE("m.oExpr")#"O"

RETURN ""

ENDIF

m.cFldName = aWizFList(m.oField.listitemid,8) &&ALLTRIM(m.oField.Value)

IF aWizFList(m.oField.listitemid,7)#''

ab1=alias()

ab2=substr(aWizFList(m.oField.listitemid,7),1,at('.',aWizFList(m.oField.listitemid,7))-1)

ab3=substr(aWizFList(m.oField.listitemid,7),at(',',aWizFList(m.oField.listitemid,7))+1,len(aWizFList(m.oField.listitemid,7))-at(',',aWizFList(m.oField.listitemid,7)))

ab4=substr(aWizFList(m.oField.listitemid,7),1,at(',',aWizFList(m.oField.listitemid,7))-1)

SELECT &ab2

SET near off

LOCATE for alltrim(upper(&ab3))=upper(m.oExpr.Value)

IF found()

ab5=alltrim(str(&ab4))

m.cFldExpr = ab5

SELECT &ab1

ENDIF

ELSE

m.cFldExpr = ALLTRIM(m.oExpr.Value)

ENDIF

* If empty expression return empty.

IF EMPTY(m.cFldExpr) AND !INLIST(m.oOp.listitemid,5,6)

RETURN ""

ENDIF

* Get data type of field

m.cDataType = aWizFList(m.oField.listitemid,2)

IF m.cDataType = "C" AND THIS.chkCaseSensitive.Value = 0

m.cFldName = "UPPER("+m.cFldName+")"

ENDIF

* Get the operator language equivalent

DO CASE

CASE m.oOp.listitemid = 1&& equals

m.cOp = "="

CASE m.oOp.listitemid = 2&& not equals

m.cOp = "<>"

CASE m.oOp.listitemid = 3&& more than

m.cOp = ">"

CASE m.oOp.listitemid = 4&& less than

m.cOp = "<"

CASE m.oOp.listitemid = 5&& is blank

RETURN "EMPTY("+m.cFldName+")"

CASE m.oOp.listitemid = 6&& is NULL

RETURN "ISNULL("+m.cFldName+")"

CASE m.cDataType = "L" && don't allow other options for logical type

m.cOp = "="

CASE m.oOp.listitemid = 7&& contains

m.cFldExpr = THIS.dataexpr("C",m.cFldExpr)

DO CASE

CASE m.cDataType = "T"

RETURN "AT("+m.cFldExpr+",TTOC("+m.cFldName+"))>0"

CASE m.cDataType = "D"

RETURN "AT("+m.cFldExpr+",DTOC("+m.cFldName+"))>0"

CASE INLIST(m.cDataType,"N","F","I","Y","B")

RETURN "AT("+m.cFldExpr+",ALLTRIM(STR("+m.cFldName+")))>0"

OTHERWISE

RETURN "AT("+m.cFldExpr+","+m.cFldName+")>0"

ENDCASE

OTHERWISE

nTotExprs = OCCURS(",",m.cFldExpr)+1

DIMENSION aExprs[m.nTotExprs]

FOR i = 1 TO m.nTotExprs

DO CASE

CASE m.i = m.nTotExprs

aExprs[m.i] = SUBSTR(m.cFldExpr,RAT(",",m.cFldExpr)+1)

CASE m.i =1

aExprs[m.i] = LEFT(m.cFldExpr,AT(",",m.cFldExpr)-1)

OTHERWISE

aExprs[m.i] = SUBSTR(m.cFldExpr,AT(",",m.cFldExpr,m.i-1)+1,;

AT(",",m.cFldExpr,m.i)-AT(",",m.cFldExpr,m.i-1)-1)

ENDCASE

aExprs[m.i] = THIS.dataexpr(m.cDataType,aExprs[m.i])

ENDFOR

DO CASE

CASE m.oOp.listitemid = 8&& in

m.cFldExpr = ""

FOR i = 1 TO m.nTotExprs

m.cFldExpr = m.cFldExpr + aExprs[m.i]

IFm.i # m.nTotExprs

m.cFldExpr = m.cFldExpr + ","

ENDIF

ENDFOR

RETURN "INLIST("+m.cFldName+","+m.cFldExpr+")"

CASE m.oOp.listitemid = 9&& between

IF ALEN(aExprs)=1

DIMENSION aExprs[2]

aExprs[2] = aExprs[1]

ENDIF

IF ALEN(aExprs)>2

DIMENSION aExprs[2]

ENDIF

RETURN "BETWEEN("+m.cFldName+","+aExprs[1]+","+aExprs[2]+")"

OTHERWISE

RETURN ""

ENDCASE

ENDCASE

DO CASE

CASE INLIST(m.cDataType,"M","G","P","O","U")

RETURN ""

CASE m.cDataType = "L"

IF TYPE(m.cFldName+m.cOp+m.cFldExpr) # "L"

IF (AT(m.cFldExpr,"fFnN")#0 AND m.cOp # "<>") OR (AT(m.cFldExpr,"tTyY")#0 AND m.cOp = "<>")

m.cFldName = "!"+m.cFldName

ENDIF

RETURN m.cFldName

ENDIF

OTHERWISE

m.cFldExpr = THIS.dataexpr(m.cDataType,m.cFldExpr)

ENDCASE

IF EMPTY(m.cFldExpr)

RETURN ""

ELSE

RETURN m.cFldName+m.cOp+m.cFldExpr

ENDIF

ENDPROC

PROCEDURE Destroy

Release aWizFList

ENDPROC

PROCEDURE Init

** Format stroki

** "@99spravochnikpolekoda,spravochnikpolenamestroka"

#DEFINE NUM_AFIELDS 16

LOCAL i

PUBLIC aWizFList

DIMENSION aWizFList[1]

DIMENSION aWizFList2[1]

=AFIELDS(aWizFList)

=AFIELDS(aWizFList2)

FOR m.i = FCOUNT() TO 1 STEP -1

IF substr(alltrim(aWizFList[m.i,8]),2,1)='@'

aWizFList[m.i,7]=substr(alltrim(aWizFList[m.i,8]),5,val(substr(alltrim(aWizFList[m.i,8]),3,2)))

aWizFList[m.i,1]=substr(alltrim(aWizFList[m.i,8]),5+val(substr(alltrim(aWizFList[m.i,8]),3,2)),;

len(alltrim(aWizFList[m.i,8]))-5-val(substr(alltrim(aWizFList[m.i,8]),3,2)))

ELSE

aWizFList[m.i,7]=''

aWizFList[m.i,1]=substr(alltrim(aWizFList[m.i,8]),2,len(alltrim(aWizFList[m.i,8]))-2)

ENDIF

aWizFList[m.i,8]=aWizFList2[m.i,1]

ENDFOR

Release aWizFList2

FOR m.i = FCOUNT() TO 1 STEP -1

IF INLIST(aWizFList[m.i,2],"G","M","U")&&Memo field

=ADEL(aWizFList,m.i)

DIMENSION aWizFList[MAX(1,ALEN(aWizFList,1)-1),NUM_AFIELDS]

ENDIF

ENDFOR

this.RowSourceType = 5

this.RowSource = "aWizFList"

this.VALUE = THIS.LIST[1]

ENDPROC

PROCEDURE InteractiveChange

IF INLIST(THIS.ListItemId,5,6)

this.Parent.txtExpr1.Value = ""

ENDIF

this.Parent.txtExpr1.ENABLED = !INLIST(THIS.ListItemId,5,6)

ENDPROC

PROCEDURE Init

#DEFINE C_OPERATORS_LOC"=\;<>\;>\;<\;если ' '\;если NULL\;содеpжится\;в\;между"

this.ADDITEM(C_OPERATORS_LOC)

this.VALUE = THIS.LIST[1]

ENDPROC

PROCEDURE Init

this.RowSourceType = 5

this.RowSource = "aWizFList"

this.VALUE = THIS.LIST[1]

ENDPROC

PROCEDURE InteractiveChange

IF INLIST(THIS.ListItemId,5,6)

this.Parent.txtExpr2.Value = ""

ENDIF

this.Parent.txtExpr2.ENABLED = !INLIST(THIS.ListItemId,5,6)

ENDPROC

PROCEDURE Init

#DEFINE C_OPERATORS_LOC"=\;<>\;>\;<\;если ' '\;если NULL\;содеpжится\;в\;между"

this.ADDITEM(C_OPERATORS_LOC)

this.VALUE = THIS.LIST[1]

ENDPROC

PROCEDURE Init

this.VALUE =1

ENDPROC

PROCEDURE Destroy

LOCAL cFilterExpr

IF THIS.ChangedFilter

IF EMPTY(THIS.SaveFilter)

SET FILTER TO

ELSE

m.cFilterExpr = THIS.SaveFilter

SET FILTER TO &cFilterExpr

ENDIF

IF RECCOUNT() # 0

GO THIS.SaveRecord

ENDIF

ENDIF

ENDPROC

PROCEDURE Init

IF !EMPTY(ALIAS())

this.SaveRecord = RECNO()

this.SaveFilter = SET("FILTER")

this.ChangedFilter = .F.

ENDIF

ENDPROC

PROCEDURE Click

#DEFINE NORECSFOUND_LOC"Hе найдено записей по данному запpосу."

DO CASE

CASE THIS.VALUE = 1&&SET FILTER condition

LOCAL cGetExpr,cSavePoint

SET FILTER TO

m.cSavePoint = SET("POINT")

SET POINT TO "."

m.cGetExpr = THISFORM.Searchclass1.searchexpr()

SET POINT TO &cSavePoint

IF !EMPTY(m.cGetExpr)

SET FILTER TO &cGetExpr

LOCATE

* Check if no records found

IF EOF()

=MESSAGEBOX(NORECSFOUND_LOC)

this.Parent.ChangedFilter = .T.

RETURN

ENDIF

this.Parent.ChangedFilter = .F.&&good query

ELSE

LOCATE

ENDIF

CASE THIS.VALUE = 2 &&SET FILTER TO all

SET FILTER TO

LOCATE

this.Parent.ChangedFilter = .F.&&good query

OTHERWISE

ENDCASE

Release THISFORM

ENDPROC

PROCEDURE ButtonRefresh

* This is a generic routine which refreshes the buttons

* for appropriate table environments.

IF SELECT()# THIS.nWorkArea

SELECT (THIS.nWorkArea)

ENDIF

this.setallprop()

this.cmdFind.Enabled = !THIS.EditMode

this.cmdPrint.Enabled = !THIS.EditMode

this.cmdExit.Enabled = !THIS.EditMode

this.cmdDelete.Enabled = !THIS.EditMode AND !ISREADONLY()

this.setcaption()

ENDPROC

PROCEDURE initvars

#DEFINE C_NOUPDATEVIEW_LOC"Edits to one or more of the Views may not be permanent. "+;

"To remedy this, ensure the View's Send SQL Updates checkbox is checked in the View Designer."

#DEFINE C_READONLY_LOC"The table is Read-Only. You will not be able to edit it."

LOCAL aTablesUsed,nTablesUsed,i,aMems,nTotMem,cWizFile,lShowedMess,cDataEnvRef

DIMENSION aTablesUsed[1]

DIMENSION aMems[1]

* This routine sets the member variables

this.viewkey = ""

this.ParentKey = ""

this.ViewType = 3

this.GridAlias = ""

this.topfile = .F.

this.endfile = .F.

this.AddMode = .F.

this.nWorkArea = SELECT()

this.oldSetDelete = SET("DELETED")

SET DELETED ON

this.oldreprocess = SET("REPROCESS")

SET REPROCESS TO 0

* These properties should not be used. They are reserved for use by

* the Preview button of the Form Wizards.

this.previewmode = IIF(TYPE("THIS.PreviewMode")#"L",.F.,THIS.previewmode)

this.previewinit = IIF(TYPE("THIS.PreviewInit")#"L",.T.,THIS.previewinit)

* Check for data environment

DO CASE

CASE TYPE("THISFORM.DataEnvironment") = "O"

this.usedataenv = .T.

nTotMem = AMEMBERS(aMems,THISFORM.DataEnvironment,2)

cDataEnvRef = "THISFORM.DataEnvironment"

CASE TYPE("THISFORMSET.DataEnvironment") = "O"

this.usedataenv = .T.

nTotMem = AMEMBERS(aMems,THISFORMSET.DataEnvironment,2)

cDataEnvRef = "THISFORMSET.DataEnvironment"

* let's also set the

IF TYPE("THISFORM")="O" AND !THISFORM.VISIBLE

thisform.VISIBLE = .T.

ENDIF

OTHERWISE

this.usedataenv = .F.

ENDCASE

IF THIS.usedataenv

WITH EVAL(m.cDataEnvRef)

* Check for relation

FOR i = 1 TO m.nTotMem

IF UPPER(EVAL("."+aMems[m.i]+".BaseClass")) = "RELATION"

this.oDataRelation = m.cDataEnvRef+"."+aMems[m.i]

EXIT

ENDIF

ENDFOR

* Check for Views

FOR i = 1 TO m.nTotMem

IF UPPER(EVAL("."+aMems[m.i]+".BaseClass")) = "CURSOR"

WITH EVAL("."+aMems[m.i])

IF CURSORGETPROP("SourceType",.Alias)#3 AND ;

!CURSORGETPROP("offline",.Alias)

* Check if we need to requery for deleted records.

* -- Note: Parameterized views are not requeried so all

* records will be brought over. To remedy this situation

* you can place a SET DELETED ON command in the

* BeforeOpenTables event of the DataEnvironment.

IF THIS.oldSetDelete = "OFF" AND ATC("?",CURSORGETPROP("SQL",.Alias))=0

=REQUERY(.Alias)

ENDIF

* Check if updates are made

IF !CURSORGETPROP("SendUpdates",.Alias) AND !m.lShowedMess

=MESSAGEBOX(C_NOUPDATEVIEW_LOC)

lShowedMess = .T.

ENDIF

ENDIF

ENDWITH

ENDIF

ENDFOR

ENDWITH

ENDIF

this.EditMode = IIF(TYPE("THIS.EditMode")#"L",.F.,THIS.EditMode)

IF ISREADONLY()

WAIT WINDOW C_READONLY_LOC TIMEOUT 2

this.EditMode = .F.

ENDIF

* Disable appropriate buttons

this.cmdAdd.Enabled = !ISREADONLY()

this.cmdEdit.Enabled = !ISREADONLY()

this.cmdDelete.Enabled = !ISREADONLY()

IF THIS.previewmode

RETURN

ENDIF

this.GetGridRef()

IF THIS.usedataenv

RETURN

ENDIF

* The following code is here to support forms not using a DataEnvironment.

this.oldSetFields = SET("FIELDS")

SET FIELDS OFF

this.oldMultiLocks = SET("MULTILOCKS")

SET MULTILOCKS ON

this.oldrefresh = SET("REFRESH")

SET REFRESH TO 5

IF !EMPTY(ALIAS())

this.oldBuffering=CursorGetProp("buffering")

m.nTablesUsed = AUSED(aTablesUsed)

FOR i = 1 TO m.nTablesUsed

IF CursorGetProp('sourcetype',aTablesUsed[m.i,1])#3&&skip for views

=CursorSetProp("buffering",5,aTablesUsed[m.i,1])&&optimistic table buffering

ENDIF

ENDFOR

ENDIF

GO TOP

ENDPROC

PROCEDURE UpdateRows

#DEFINEE_FAIL_LOC"Iе удалось обновить таблицу: "

#DEFINEE_TRIGGERFAIL_LOC"Odиaеd не сdаботал."

#DEFINEE_FIELDNULL_LOC"Iоле не допускает значения NULL"

#DEFINEE_FIELDRULE_LOC"Iаdуoено пdавило для поля"

#DEFINEE_RECORDLOCK_LOC"Запись используется дdуaим пользователем"

#DEFINEE_ROWRULE_LOC"Iаdуoено пdавило для стdоки"

#DEFINEE_UNIQUEINDEX_LOC"Iаdуoена уникальность индекса"

#DEFINEE_DIRTYREC_LOC"Данные были изменены дdуaим пользователем. Iеdезаписать изменения сделанные вами?"

#DEFINEE_NOFORCE_LOC"Iевозможно коddектиdовать таблицу."

#DEFINE E_PROMPT_LOC "Ioибка: "

#DEFINE MSGBOX_YES6

LOCAL aErrors,cErrorMessage,aTablesUsed,nTablesUsed,nTotErr

LOCAL nFld,i,nOldArea,lSuccess,lInDBC,lOverwrite,lHadMessage

DIMENSION aTablesUsed[1]

DIMENSION aErrors[1]

m.cErrorMessage=""

m.lSuccess = .T.

m.nOldArea = SELECT()

m.nTablesUsed = AUSED(aTablesUsed)

* Can wrap everything in transaction if using strictly DBCs

FOR i = 1 TO m.nTablesUsed

SELECT (aTablesUsed[m.i,1])

m.lInDBC = !EMPTY(CURSORGETPROP("Database"))

m.cErrorMessage = ""

m.lOverwrite = .F.

m.lHadMessage = .F.

DO CASE

CASE CURSORGETPROP("Buffering") = 1

* Skip if buffering not on

LOOP

CASE GetFldState(0) = 2&&deleted record

* Only delete current record and force it

m.lSuccess = TableUpdate(.F.,.T.)

IF m.lSuccess&&successful update

LOOP

ENDIF

CASE !m.lInDBC AND (ATC("2",GetFldState(-1))#0 OR;

ATC("3",GetFldState(-1))#0)

* Field was edited - in Free Table

* Since free tables are not supported by transactions,

* we must process record by record

m.nModRecord = GetNextMod(0)

DO WHILE m.nModRecord # 0&&loop locks all records

GO m.nModRecord

m.lSuccess = RLOCK()&&try to lock record

IF !m.lSuccess&&failed to lock record

m.cErrorMessage = E_RECORDLOCK_LOC

UNLOCK ALL

EXIT

ENDIF

IF !m.lHadMessage&&so we don't repeat alert

* See if record(s) modified by another user

FOR m.nFld = 1 TO FCOUNT()

IF TYPE(FIELD(m.nFld)) = "G"&&skip for General fields

LOOP

ENDIF

IF OLDVAL(FIELD(m.nFld)) # CURVAL(FIELD(m.nFld))

m.lHadMessage = .T.

IF MESSAGEBOX(E_DIRTYREC_LOC,4+48) = MSGBOX_YES

m.lOverwrite = .T.

ELSE

m.lSuccess = .F.

UNLOCK ALL

EXIT

ENDIF

ENDIF

ENDFOR

ENDIF

m.nModRecord = GetNextMod(m.nModRecord)

ENDDO

IF m.lSuccess &&was able to lock all records

m.lSuccess = TableUpdate(.T.,m.lOverwrite)

IF m.lSuccess &&was able to update all records

LOOP

ENDIF

UNLOCK ALL

ENDIF

CASE m.lInDBC

BEGIN TRANSACTION

* Try to update all records in selected table

m.lSuccess = TableUpdate(.T.,.F.)&&successful update

IF m.lSuccess

END TRANSACTION

LOOP

ENDIF

ROLLBACK

ENDCASE

* Handle errors

nTotErr =AERROR(aErrors)

DO CASE

CASE nTotErr = 0

CASE aErrors[1,1] = 1539&& Trigger failed

m.cErrorMessage = E_TRIGGERFAIL_LOC

CASE aErrors[1,1] = 1581&& Field doesn't accept NULL

m.cErrorMessage = E_FIELDNULL_LOC

CASE aErrors[1,1] = 1582&& Field rule violated

m.cErrorMessage = E_FIELDRULE_LOC

CASE aErrors[1,1] = 1700&& Record in use by another user

m.cErrorMessage = E_RECORDLOCK_LOC

CASE aErrors[1,1] = 1583&& Row rule violated

m.cErrorMessage = E_ROWRULE_LOC

CASE aErrors[1,1] = 1884&& Unique index violation

m.cErrorMessage = E_UNIQUEINDEX_LOC

CASE aErrors[1,1] = 1585&& Record changed by another user

IF m.lInDBC&&handle free tables above

* Dislpay conflict alert

IF MESSAGEBOX(E_DIRTYREC_LOC,4+48) = MSGBOX_YES

*Try to force update

BEGIN TRANSACTION

m.lSuccess = TABLEUPDATE(.T.,.T.)

IF m.lSuccess

END TRANSACTION

LOOP

ELSE

ROLLBACK

=MESSAGEBOX(E_NOFORCE_LOC)

ENDIF

ENDIF

ENDIF

OTHERWISE

IF !EMPTY(m.cErrorMessage)&&for free table handling above

m.cErrorMessage = E_PROMPT_LOC+aErrors[1,2]

ENDIF

ENDCASE

* Had an error we couldn't handle

=TABLEREVERT(.T.) &&revert all records

m.lSuccess = .F.

IF !EMPTY(m.cErrorMessage)

=MESSAGEBOX(E_FAIL_LOC+m.cErrorMessage)

ENDIF

ENDFOR

SELECT (m.nOldArea)

RETURN m.lSuccess

ENDPROC

PROCEDURE setcaption

#DEFINE ADD_CAPTION_LOC"\<Add"

#DEFINE EDIT_CAPTION_LOC"\<Edit"

#DEFINE REV_CAPTION_LOC"\<Revert"

#DEFINE SAVE_CAPTION_LOC"\<Save"

IF THIS.EditMode

this.cmdAdd.Caption = SAVE_CAPTION_LOC

this.cmdEdit.Caption = REV_CAPTION_LOC

ELSE

this.cmdAdd.Caption = ADD_CAPTION_LOC

this.cmdEdit.Caption = EDIT_CAPTION_LOC

ENDIF

ENDPROC

PROCEDURE setallprop

LPARAMETER oContainer

* Checks for General fields

LOCAL i,oControlParent,nCtrlCount

IF PARAMETERS() = 0

m.oControlParent = THISFORM

ELSE

m.oControlParent = m.oContainer

ENDIF

DO CASE

CASE ATC("Pageframe",m.oControlParent.BaseClass)#0

nCtrlCount = oControlParent.PageCount

CASE ATC(m.oControlParent.BaseClass,"Optiongroup,Commandgroup")#0

nCtrlCount = oControlParent.ButtonCount

OTHERWISE

nCtrlCount = oControlParent.ControlCount

ENDCASE

FOR i = 1 TO m.nCtrlCount

DO CASE

CASE ATC("Pageframe",m.oControlParent.BaseClass)#0

this.setallprop(m.oControlParent.Pages[m.i])

CASE ATC(m.oControlParent.BaseClass,"Optiongroup,Commandgroup")#0 AND ;

THIS.UserControlMode

m.oControlParent.Buttons[m.i].Enabled = THIS.EditMode

CASE ATC(m.oControlParent.Controls[m.i].BaseClass,"Optiongroup,Commandgroup")#0 ;

AND THIS.UserControlMode

this.setallprop(m.oControlParent.Controls[m.i])

CASE ATC("Container",m.oControlParent.Controls[m.i].BaseClass) # 0 OR;

ATC("Page",m.oControlParent.Controls[m.i].BaseClass) # 0

this.setallprop(m.oControlParent.Controls[m.i])

CASE ATC(m.oControlParent.Controls[m.i].BaseClass,"ListBox,ComboBox,Spinner") # 0 &&AND;

&&THIS.UserControlMode

m.oControlParent.Controls[m.i].Enabled = THIS.EditMode

CASE ATC(m.oControlParent.Controls[m.i].BaseClass,"CheckBox,TextBox,OleBoundControl") # 0

m.oControlParent.Controls[m.i].Enabled = THIS.EditMode

CASE ATC(m.oControlParent.Controls[m.i].BaseClass,"EditBox,TextBox") # 0

m.oControlParent.Controls[m.i].ReadOnly = !THIS.EditMode

IF !THIS.HasMemo

WITH m.oControlParent.Controls[m.i]

this.EditForeColor = .ForeColor

this.EditDisForeColor = .DisabledForeColor

this.EditBackColor = .BackColor

this.EditDisBackColor = .DisabledBackColor

this.HasMemo = .T.

ENDWITH

ENDIF

m.oControlParent.Controls[m.i].ForeColor = IIF(THIS.EditMode,THIS.EditForeColor,THIS.EditDisForeColor)

m.oControlParent.Controls[m.i].BackColor = IIF(THIS.EditMode,THIS.EditBackColor,THIS.EditDisBackColor)

* CASE ATC(m.oControlParent.Controls[m.i].BaseClass,"Grid") # 0

* m.oControlParent.Controls[m.i].ReadOnly = !THIS.EditMode

*m.oControlParent.Controls[m.i].DeleteMark = THIS.EditMode

ENDCASE

ENDFOR

ENDPROC

PROCEDURE NavRefresh

**** Navigational Button Handling ****

LOCAL OldLockScreen,KeyValue,cFiltExpr

m.OldLockScreen = THISFORM.LockScreen

thisform.LockScreen = .T.

IF SELECT()#THIS.nWorkArea

SELECT (THIS.nWorkArea)

ENDIF

IF !THIS.EditMode

* Check for bottom of file

this.endfile = EOF() OR THIS.endfile

* Test to see we are on last record

IF !THIS.endfile

Skip

this.endfile = EOF()

Skip -1

ELSE

GO BOTTOM

ENDIF

* Check for top of file

this.topfile = BOF() OR EOF() OR THIS.topfile

* Test to see if we are on first record

IF !THIS.topfile

Skip -1

this.topfile = BOF()

IF !THIS.topfile

Skip

ENDIF

ENDIF

IF THIS.topfile

GO TOP

ENDIF

ENDIF

this.cmdTop.Enabled = !THIS.topfile AND !THIS.EditMode

this.cmdPrev.Enabled = !THIS.topfile AND !THIS.EditMode

this.cmdNext.Enabled = !THIS.endfile AND !THIS.EditMode

this.cmdEnd.Enabled = !THIS.endfile AND !THIS.EditMode

* Check if no records in query set

DO CASE

CASE THIS.previewmode OR ISREADONLY()

* Nothing

CASE THIS.EditMode AND CURSORGETPROP("BUFFERING")=1

this.cmdEdit.Enabled = .F.

CASE THIS.EditMode

this.cmdEdit.Enabled = .T.

CASE RECCOUNT()=0 OR BOF() OR EOF()

this.cmdEdit.Enabled = .F.

this.cmdDelete.Enabled = .F.

CASE !THIS.cmdEdit.Enabled

this.cmdEdit.Enabled = .T.

this.cmdDelete.Enabled = .T.

ENDCASE

* Update Grid for Views

IF !THIS.EditMode AND !EMPTY(THIS.viewkey)

KeyValue = EVAL(THIS.ParentKey)

DO CASE

CASE TYPE(THIS.ParentKey) = "C"

cFiltExpr = THIS.viewkey + "=" + "["+m.KeyValue+"]"

CASE TYPE(THIS.ParentKey) = "L"

cFiltExpr = THIS.viewkey

CASE TYPE(THIS.ParentKey) = "D"

cFiltExpr = THIS.viewkey + "=" + "{"+DTOC(m.KeyValue)+"}"

CASE TYPE(THIS.ParentKey) = "T"

cFiltExpr = THIS.viewkey + "=" + "{"+TTOC(m.KeyValue)+"}"

OTHERWISE

* Numeric

cFiltExpr = THIS.viewkey + "=" + ALLTRIM(STR(m.KeyValue,20,18))

ENDCASE

SELECT (THIS.GridAlias)

DO CASE

CASE .F. &&parameterized query

* set parameter here

* =requery()

CASE THIS.ViewType = 1&&local views

SET FILTER TO &cFiltExpr

CASE THIS.ViewType = 2&&remote views

ENDCASE

SELECT (THIS.nWorkArea)

ENDIF

thisform.Refresh()

thisform.LockScreen = m.OldLockScreen

ENDPROC

PROCEDURE GetGridRef

* Check if we have a grid

LOCAL aMems,nTotMem,i

this.GridRef = ""

IF TYPE("THISFORM") = "O"

DIMENSION aMems[1]

nTotMem = AMEMBERS(aMems,THISFORM,2)

WITH THISFORM

FOR i = 1 TO m.nTotMem

IF UPPER(EVAL("."+aMems[m.i]+".BaseClass")) = "GRID"

this.GridRef = aMems[m.i]

WITH EVAL("."+THIS.GridRef)

* Check if we have a view and get Tag property

this.ViewType = CURSORGETPROP('sourcetype',.RecordSource)

this.GridAlias = .RecordSource

IF THIS.ViewType # 3

this.viewkey = .Tag

this.ParentKey = .Comment

ENDIF

ENDWITH

EXIT

ENDIF

ENDFOR

ENDWITH

ENDIF

ENDPROC

PROCEDURE Destroy

* Restore various settings

LOCAL nTablesUsed,aTablesUsed,i,nDECursors,aDECursors,cDataEnvRef

DIMENSION aTablesUsed[1]

IF TYPE('THIS.Parent') # "O"

RETURN

ENDIF

IF TYPE("THIS.oldTalk") = "C" AND THIS.oldTalk="ON"

SET TALK ON

ENDIF

* OLE Servers can still send data back to General fields

* even though they are not in Edit Mode. We need to reset

* buffering to 1 so the buffer is not updated by the OLE Server.

* Also, folks might exit out while editing.

IF THIS.usedataenv

DIMENSION aDECursors[1]

DO CASE

CASE TYPE("THISFORM.DataEnvironment") = "O"

nDECursors = AMEMBERS(aDECursors,THISFORM.DataEnvironment,2)

cDataEnvRef = "THISFORM.DataEnvironment"

CASE TYPE("THISFORMSET.DataEnvironment") = "O"

nDECursors = AMEMBERS(aDECursors,THISFORMSET.DataEnvironment,2)

cDataEnvRef = "THISFORMSET.DataEnvironment"

ENDCASE

FOR i = 1 TO m.nDECursors

WITH EVAL(m.cDataEnvRef + "." + aDECursors[m.i])

IF USED(.ALIAS) AND ATC("CURSOR",.BaseClass)#0 AND ;

CursorGetProp("sourcetype",.ALIAS)=3 AND ;

CursorGetProp("buffering",.ALIAS)>1

=TableRevert(.T.,.ALIAS)

=CursorSetProp("buffering",1,.ALIAS)&&optimistic table buffering

ENDIF

ENDWITH

ENDFOR

ENDIF

* Skip if using preview mode

IF THIS.previewmode

RETURN

ENDIF

IF THIS.oldSetDelete = "OFF"

SET DELETED OFF

ENDIF

SET REPROCESS TO THIS.oldreprocess

SET MESSAGE TO

SELECT (THIS.nWorkArea)

IF THIS.usedataenv

RETURN

ENDIF

* The following code is here to support

* forms not using a DataEnvironment.

m.nTablesUsed = AUSED(aTablesUsed)

FOR i = 1 TO m.nTablesUsed

IF USED(aTablesUsed[m.i,1]) AND ATC(".TMP",DBF(aTablesUsed[m.i,1]))=0&&skip for views

=CursorSetProp("buffering",THIS.oldBuffering,aTablesUsed[m.i,1])&&optimistic table buffering

ENDIF

ENDFOR

IF THIS.oldMultiLocks = "OFF"

SET MULTILOCKS OFF

ENDIF

IF THIS.oldSetFields = "ON"

SET FIELDS ON

ENDIF

SET REFRESH TO THIS.oldrefresh

ENDPROC

PROCEDURE Error

PARAMETERS nError, cMethod, nLine

LOCAL aFoxErr,nTotErr

DIMENSION aFoxErr[1]

nTotErr = AERROR(aFoxErr)

DO CASE

CASE INLIST(m.nError,1733,1734) &&property not found -- traps SETALL()

RETURN

CASE m.nError=1938 &&no parent

RETURN

CASE nTotErr>0 AND aFoxErr[1,1] = 1420

* Corrupt Ole object in General field.

=MESSAGEBOX(aFoxErr[1,2])

RETURN

CASE nTotErr>0 AND aFoxErr[1,1] = 1884

* Uniqueness ID error

=MESSAGEBOX(MESSAGE()+CHR(13))

RETURN

ENDCASE

**** Error Dialog ******

=MESSAGEBOX(MESSAGE(1)+CHR(13)+;

"Error: "+STR(nError)+CHR(13)+;

MESSAGE()+CHR(13)+;

"Method: "+cMethod+CHR(13)+;

"Line: "+STR(nLine))

RETURN TO MASTER

ENDPROC

PROCEDURE Init

#DEFINE C_WIZSTYLE"WIZSTYLE.VCX"

#DEFINE C_WIZDIR "WIZARDS\"

#DEFINE C_PROMPT1_LOC"Find: "

#DEFINE E_NOSTYLE_LOC"The class library (WIZSTYLE.VCX) needed by this form could not be found. "+;

"Please locate."

LOCAL cGridRef,cWizHomePath,separator,cWizStyFile

IF TYPE('THIS.Parent') # "O"

RETURN

ENDIF

IF SET("TALK") = "ON"

SET TALK OFF

this.oldTalk = "ON"

ELSE

this.oldTalk = "OFF"

ENDIF

IF ATC(C_WIZSTYLE,SET("CLASSLIB")) = 0

* Returns just the pathname

cWizHomePath = _WIZARD

IF '\' $ cWizHomePath

cWizHomePath = SUBSTR(m.cWizHomePath,1,RAT('\',m.cWizHomePath))

IF RIGHT(m.cWizHomePath,1) = '\' AND LEN(m.cWizHomePath) > 1 ;

AND SUBSTR(m.cWizHomePath,LEN(m.cWizHomePath)-1,1) <> ':'

cWizHomePath = SUBSTR(m.cWizHomePath,1,LEN(m.cWizHomePath)-1)

ENDIF

ELSE

cWizHomePath = ''

ENDIF

* Add a backslash unless there is one already there.

Separator = IIF(_MAC,":","\")

IF !(RIGHT(m.cWizHomePath,1) $ '\:') AND !EMPTY(m.cWizHomePath)

m.cWizHomePath= m.cWizHomePath+ m.separator

ENDIF

DO CASE

CASE FILE(C_WIZSTYLE)

cWizFile = C_WIZSTYLE

CASE FILE(m.cWizHomePath+C_WIZSTYLE)

cWizFile = m.cWizHomePath+C_WIZSTYLE

CASE FILE(m.cWizHomePath+C_WIZDIR+C_WIZSTYLE)

cWizFile = m.cWizHomePath+C_WIZDIR+C_WIZSTYLE

CASE FILE(HOME()+C_WIZSTYLE)

cWizFile = HOME()+C_WIZSTYLE

CASE FILE(HOME()+C_WIZDIR+C_WIZSTYLE)

cWizFile = HOME()+C_WIZDIR+C_WIZSTYLE

OTHERWISE

=MESSAGEBOX(E_NOSTYLE_LOC)

cWizFile = GETFILE("VCX",C_PROMPT1_LOC+C_WIZSTYLE)

ENDCASE

IF ATC(C_WIZSTYLE,m.cWizFile)#0

SET CLASS TO (m.cWizFile) ADDITIVE

ELSE

* Failed to get WIZSTYLE.VCX file

RETURN .F.

ENDIF

ENDIF

this.initvars()

this.ButtonRefresh()

this.NavRefresh()

cGridRef=THIS.GridRef

IF !EMPTY(m.cGridRef)

* Change this if you desire to have the grid initially selected.

thisform.&cGridRef..SetFocus()

ENDIF

ENDPROC

PROCEDURE Refresh

**** Special Preview Mode Handling ****

IF THIS.previewmode AND THIS.previewinit

this.previewinit = .F.

this.cmdAdd.Enabled = .F.

this.cmdEdit.Enabled = .F.

this.cmdDelete.Enabled = .F.

this.cmdFind.Enabled = .F.

this.cmdPrint.Enabled = .F.

this.cmdExit.Enabled = .F.

this.nWorkArea = SELECT()

this.GetGridRef()

this.setallprop()

this.NavRefresh()

ENDIF

ENDPROC

PROCEDURE Click

SELECT (THIS.parent.nWorkArea)

IF !BOF()

Skip -1

ENDIF

this.Parent.topfile = BOF()

this.Parent.endfile = EOF()

this.Parent.NavRefresh()

ENDPROC

PROCEDURE Click

SELECT (THIS.parent.nWorkArea)

IF !EOF()

Skip 1

ENDIF

this.Parent.endfile = EOF()

this.Parent.topfile = BOF()

this.Parent.NavRefresh()

ENDPROC

PROCEDURE Click

SELECT (THIS.parent.nWorkArea)

LOCATE

this.Parent.topfile = .T.

this.Parent.endfile = EOF()

this.Parent.NavRefresh()

ENDPROC

PROCEDURE Click

SELECT (THIS.parent.nWorkArea)

GO BOTTOM

this.Parent.topfile = .F.

this.Parent.endfile = .T.

this.Parent.NavRefresh()

ENDPROC

PROCEDURE Click

LOCAL oSearchDlog

LOCAL lVisChange,lStateChange

* Check if SDI Window

IF THISFORM.ShowWindow = 2

IF !_VFP.Visible

_VFP.Visible = .T.

lVisChange = .T.

ENDIF

IF _SCREEN.WindowState = 1

_SCREEN.WindowState = 0

lStateChange = .T.

ENDIF

ENDIF

oSearchDlog = CREATE("searchform")

oSearchDlog.Icon=ThisForm.Icon

oSearchDlog.caption="Hайти"

oSearchDlog.SHOW()

IF m.lVisChange

_VFP.Visible = .F.

ENDIF

IF m.lStateChange

_SCREEN.WindowState = 1

ENDIF

IF THISFORM.ShowWindow = 2

Activate Window (THISFORM.Name)

ENDIF

* Reset from prior

this.Parent.topfile = .F.

this.Parent.endfile = .F.

this.Parent.NavRefresh()

ENDPROC

PROCEDURE Click

#DEFINE C_MAKEREPO_LOC"Could not locate a report to print. Create new one?"

#DEFINE C_NOOPEN_LOC"Error opening table. Unable to print report."

#DEFINE C_GETFILEPROMPT_LOC"Pick report:"

LOCAL cRepName,nSaveSess,cSaveAlias,cSaveSource,cSaveData

cSaveAlias = ALIAS()

cSaveSource = CURSORGETPROP("SourceName")

cSaveData = CURSORGETPROP("Database")

cDiffSource = ""

cRepName = LEFT(ALIAS(),8)+".FRX"

nSaveSess = SET("DATASESSION")

* Handling for Private data sessions

#IF 0

IF m.nSaveSess # 1

SET DATASESSION TO 1

SELECT 0

IF !EMPTY(m.cSaveData)

OPEN DATABASE (m.cSaveData)

ENDIF

IF USED(m.cSaveAlias)

SELECT (m.cSaveAlias)

IF CURSORGETPROP("SourceName")#m.cSaveSource

cDiffSource = CURSORGETPROP("SourceName")

USE IN (m.cSaveAlias)

SELECT 0

ENDIF

ENDIF

IF EMPTY(ALIAS())

USE (m.cSaveSource) AGAIN ALIAS (m.cSaveAlias) SHARED

IF EMPTY(ALIAS())

=MESSAGEBOX(C_NOOPEN_LOC)

RETURN

ENDIF

ENDIF

ENDIF

#ENDIF

IF FILE(m.cRepName)

REPORT FORM (m.cRepName) PREVIEW NOWAIT

ELSE

m.cRepName = GETFILE("frx",C_GETFILEPROMPT_LOC,"",1)

IF !EMPTY(m.cRepName)

IF FILE(m.cRepName)

* User pressed Open button

REPORT FORM (m.cRepName) PREVIEW NOWAIT

ELSE

* User pressed New button

DO HOME()+"wizards\wzreport.app" WITH ALIAS(), "AUTOREPORT"

ENDIF

ENDIF

ENDIF

* Private data session code

#IF 0

IF !EMPTY(cDiffSource)

USE (m.cDiffSource) IN 0

ENDIF

SET DATASESSION TO m.nSaveSess

SELECT (m.cSaveAlias)

#ENDIF

IF THISFORM.ShowWindow = 2

Activate Window (THISFORM.Name)

ENDIF

ENDPROC

PROCEDURE Click

thisform.Release

ENDPROC

PROCEDURE Click

#DEFINE OPT_CANCEL0

#DEFINE OPT_ADD_PARENT1

#DEFINE OPT_ADD_CHILD2

#DEFINE OPT_ADD_BOTH3

#DEFINE MB_Q_YESNO36

#DEFINE MB_A_YES6

#DEFINE C_KEYFLDNOUPDATE_LOC"The field relating the grid's view to the parent data source is not updatable. "+;

"Do you just want to add a new record to the parent table?"

#DEFINE C_BADCHILDKEY_LOC"The fields relating the parent and child tables are not the same data type. "+;

"Do you just want to add a new record to the parent table?"

#DEFINE C_NOCHILDUPDATE_LOC"The child data source is a view and does not send updates. "+;

"Do you just want to add a new record to the parent table?"

#DEFINE C_NOOBJ_LOC"Failed create the Add Record form class. Check or reinstall your WIZSTYLE.VCX file."

#DEFINE C_NOUPDATE_LOC"You cannot add a new record because the view(s) selected does not send updates."

#DEFINE C_NOUPDATE2_LOC"You cannot add a new record because the view(s) selected does not send updates and the child data source has a primary key."