Mini Kabibi Habibi

Current Path : C:/Users/ITO/Desktop/VF9/program files/microsoft visual foxpro 9/wizards/
Upload File :
Current File : C:/Users/ITO/Desktop/VF9/program files/microsoft visual foxpro 9/wizards/wizbase.vct

.@VERSION =  3.029T���{�
�۞X�NƼ�\�DOUBLEshapeshapewizshape;Height = 68
Width = 68
wizeffect = 0
Name = "wizshape"
Class1wizeffect
Pixels	container	container	layoutsty�Width = 517
Height = 205
TabIndex = 0
odimensions = Shape1
olabel1 = Shape2
olabel2 = Shape3
ocol2 = Shape4
Name = "layoutsty"
ClassR��A:�d�����@
ST�ݰ_�7�HP��OPEN�5&odimensions
olabel1
olabel2
ocol2
stylebmp\layout.bmpstylebmp\layout.bmpPixelsshapeshapeShape1	layoutsty?Height = 205
Left = 0
Top = 0
Width = 517
Name = "Shape1"
shapeshapeShape2	layoutsty?Height = 13
Left = 24
Top = 24
Width = 37
Name = "Shape2"
shapeshapeShape3	layoutsty?Height = 13
Left = 24
Top = 45
Width = 37
Name = "Shape3"
shapeshapeShape4	layoutsty@Height = 13
Left = 228
Top = 24
Width = 37
Name = "Shape4"
!Arial, 0, 9, 5, 15, 12, 32, 3, 0
baseformPixelsstylebmp\form.bmpstylebmp\form.bmpClass1formbaseform�wizlayout Class reference for layout object.
wizfield Class reference for a field object.
wizmemo Class reference for a memo field object.
wizlogic Class reference for a logic field object.
wizole Class reference for a general field object.
wizmaxcharfld Max width of character field before using editbox memo object.
wizlblsuffix Character expression added to the end of each label (e.g., :).
wizlblcap Label capitalization (proper, normal, upper or lower).
wizformstretch Whether to shrink/expand form (height only) based on number of fields selected.
wizlbldefwid Whether to use fixed label width for consistent look and alignment of fields on form.
wiztitle Class reference for title object (label).
wizuser For use by user.
wizgrid Class reference for grid object with 1-Many forms.
wizverify Whether to verify class objects (use for testing but can improve performance if set .F.).
wizbuttons Class reference for button set object.
wizbtnpos Button position centering (0-none, 1-hori, 2-vert, 3-both). By default, buttons are centered in footer. You can use these settings for better control over how buttons are placed, especially if buttons are vertically laid out.
wizcodestyle Whether to use code style or button style.
wizbtnlayout Button position object (class) if one used for unique placement of buttons. 
wizcaptions Whether to use DBC long name label captions.
wizbuffering Data environment table buffering setting.
wizgridform Whether to use a separate form for grid object.
wizlabel Class reference for label object.
wizlblspace Space between label and field.
wizcboxlbl Whether to use the checkbox as the label.
wizpages Allows use of pages for overflow of fields (0 - none, 1 - single column, 2 - multi column).
wizpagestyle This is style class for page frame.
wizappclass Name of application class to add to form.
wizappclasslibrary Name of application class library to add to form.
wizappobject Name used on form for application class.
lshowfirsttime
haderror Whether an error occurred.
lpromptkey Whether to prompt for primary key value.
lsavebuffereddata
lupdateallbufferedtables
*pickrecord 
*addrecord 
*resolveconflicts 
*deleterecord 
�� ���	%��H�U�/%�C�THIS.APP_MEDIATOR.BaseClassb�C��3�B��%�C�������%�����CC�
	����
��C����%�C���CN�����
��C�������UTHISAPP_MEDIATORPICKRECORDTOWORKONLADDINGREFRESH	ADDRECORD	���������%�C+�C��6�#)��T��CO��
H�S����C�WIZBTNS.VCX0����T���WIZBTNS.VCX��*�CC�Q�WIZARDS\�WIZBTNS.VCX0����(T��C�Q�WIZARDS\�WIZBTNS.VCX��2���
T������
H�����F�C�
SourceType��C�offline�
	�C�SendUpdates�
	����[��C�OYou cannot add a new record because the view(s) selected does not send updates.�x��B�-���CC�databaseꉡ������C�
SourceType������(�C�	buffering����
	�����C����(��2���T��C�DATABASEv��G(�C�database��2T��CC�
sourcename��Table�
PrimaryKey��T��C�
��W��SET DATABASE TO &lcSaveData
%�C���
�
����������T��C�
�m��T��C�	AddRecord�����T��C�custom�N��T��	��
���T��
�C�
���T������
��C����%���
�����r��C���
������
�����T���a�����%�������T���-��	#����B�-���
��C����U	LNSAVEREC
LCSAVEDATALOADDRECLOCUSTOMCPRIMARYKEY
LCCLASSLIBNPRIMARYKEYTHIS
LPROMPTKEY	CKEYFIELD	CKEYVALUE	ORETVALUESHOW
NBTNACTIONHADERRORTHISFORMREFRESH�%���
���B�������������	�
��x%�C�THIS.ActiveControl.baseclassb�C�C���value��h	�C���
controlsource��h	�
C���
�
	��
�T������%�C��
���
����T��������
T������
T�����
T�����
�����
H�E��,�C�THISFORM.DataEnvironmentb�O����T��C������b��%T���THISFORM.DataEnvironment��/�C�THISFORMSET.DataEnvironmentb�O��#�T��C������b��(T���THISFORMSET.DataEnvironment�������E�T��C���y��2��%�CC�
��{�T�����C��
T���������
���(��
�����%�C�
������T��C�
�
����!�!��C�
��.C�
�
����%�C�CURSOR������.��T��������D%�C���C�
sourcetype��	�C�	buffering��	����%��
�
��}� %�C�	buffering������%�C�������.�����T��C������%�C�1C�>QC�_����.���IT�	�C�6Data has been changed. Would you like to save changes?�#�x��%��	���\�B�-���T���	���T��a���%��
�������Caa������
��Ca�������UTHISLSAVEBUFFEREDDATA
NDECURSORS
ADECURSORSCDATAENVREFLPROMPTSAVE
LHADPROMPTLCALIASLNFIELDSNPROMPTSAVEILOCURRENTCONTROL
ACTIVECONTROL
CONTROLSOURCEVALUETHISFORMDATAENVIRONMENTTHISFORMSETLUPDATEALLBUFFEREDTABLES	BASECLASSALIAS����T��-��
%�C�
��#�B��9%�C�"Do you want to delete this record?�$�x������+�C'�C+����%�C+����
%������!��#)�T��a�����H���
�����%��������t,������ULLHADEOFTHISFORMREFRESH
SHOWWINDOWNAME
B���
��UTHISHADERROR�/%�C�THIS.APP_MEDIATOR.BaseClassb�C��T�%�C��
��L���B�-���B��
%�C����%�C���
������B�-��������B�-���UTHISRESOLVECONFLICTSAPP_MEDIATORQUERYUNLOAD|������:%�C�THIS.APP_MEDIATOR.BaseClassb�C���
��L�B��T���-��T���-��
��C����UNSTYLELCAPPREFTHISLSHOWFIRSTTIMELSAVEBUFFEREDDATA
PICKRECORD����������
�����T��C���z��T���a��
H�T�-��C������k�B�$����C�����	������CC����x��B��������%�C+����#6����#)��B����\����%�C�	buffering���F�6��C�*A unique key error violation has occurred.�x��B��k%�C�*A unique key error violation has occurred.� �!Would you like to revert changes?�$�x�����
��Ca���B�������-�P��C�DError: Table is in use. The table may already be opened exclusively.�x��B��Z��CC�EC�
 �Error: C�ZC�
 CEC�
 �Method: �C�
 �Line: C�Z�x��UNERRORCMETHODNLINEAFOXERRNTOTERRTHISHADERROR$%�C��
�����B�-���UTHISQUERYUNLOAD
pickrecord,��	addrecord#��resolveconflicts���deleterecord���Load���QueryUnload���Show�
��Error���Releasee��1�AAB����AAA3�"QA��������A�c�q�R�R�R�S�qa!!��Q��a!A�A���AAA��qA�3AArq��1A�A������Q���!��!�AA�A��AA�AACqAA�A�AAA�qA!�A����AAA3t��AA�A1��AAQ��AAA�AB�A3�3�!AqAAA�QAqA�AqA3qq�AA���3���!��1AA2A�Q�QAA!�aAA��AA!AA�3!AqA2P
ppD�+Y�Ne���������������?��]�")��PROCEDURE pickrecord
IF TYPE("THIS.APP_MEDIATOR.BaseClass")#"C"
	RETURN
ENDIF

IF THIS.APP_MEDIATOR.PickRecordToWorkOn()
	IF THIS.APP_MEDIATOR.lAdding AND !EMPTY(ALIAS())
		THIS.REFRESH()
		* Check if we have blank record already from txtbtns
		IF GETFLDSTATE(1)#3 OR RECCOUNT()=0
			THIS.AddRecord()
		ENDIF
	ENDIF
ENDIF

ENDPROC
PROCEDURE addrecord
#DEFINE C_NOUPDATE_LOC	"You cannot add a new record because the view(s) selected does not send updates."
#DEFINE	DIALOG_CLASSLIB "WIZBTNS.VCX"

LOCAL lnSaveRec,lcSaveData,loAddRec,loCustom,cPrimaryKey,lcClassLib,nPrimaryKey

IF EOF() OR BOF()
	GO TOP
ENDIF
lnSaveRec = RECNO()

DO CASE
CASE FILE(DIALOG_CLASSLIB)
	lcClassLib = DIALOG_CLASSLIB
CASE FILE(HOME()+"WIZARDS\"+DIALOG_CLASSLIB)
	lcClassLib = HOME()+"WIZARDS\"+DIALOG_CLASSLIB
OTHERWISE
	lcClassLib = ""
ENDCASE

DO CASE
CASE CURSORGETPROP("SourceType")#3 AND ;
  !CURSORGETPROP("offline") AND ;
  !CURSORGETPROP("SendUpdates")
	MESSAGEBOX(C_NOUPDATE_LOC)
	RETURN .F.
CASE EMPTY(CURSORGETPROP("database")) 
	* Free table
	APPEND BLANK
CASE CURSORGETPROP("SourceType")#3
	* View
	APPEND BLANK
CASE CURSORGETPROP("buffering")#1 AND !THIS.lPromptKey
	* buffered data
	APPEND BLANK
CASE EMPTY(lcClassLib)
	* could disable this if you feel 
	* potential unique ID conflicts could arise
	APPEND BLANK
OTHERWISE
	lcSaveData = SET("DATABASE")
	SET DATABASE TO CURSORGETPROP("database")
	cPrimaryKey = DBGETPROP(CURSORGETPROP("sourcename"),"Table","PrimaryKey")
	nPrimaryKey = TAGNO(m.cPrimaryKey)
	SET DATABASE TO &lcSaveData
	IF EMPTY(cPrimaryKey) OR m.nPrimaryKey=0
		APPEND BLANK
	ELSE
		cPrimaryKey=KEY(m.nPrimaryKey)
		loAddRec=NewObject("AddRecord",lcClassLib,"")
		loCustom = Create('custom')
		loAddRec.cKeyField = m.cPrimaryKey
		loAddRec.cKeyValue = EVAL(m.cPrimaryKey)
		loAddRec.oRetValue = loCustom
		loAddRec.Show()
		IF loCustom.nBtnAction=1
			INSERT INTO (ALIAS()) ((m.cPrimaryKey)) VALUES(loCustom.cKeyValue)
		ELSE
			THIS.HadError = .T.	
		ENDIF
	ENDIF
ENDCASE

IF THIS.HadError
	THIS.HadError = .F.
	GO lnSaveRec
	RETURN .F.
ENDIF

THISFORM.Refresh()

ENDPROC
PROCEDURE resolveconflicts
#DEFINE PROMPTTOSAVE_LOC	"Data has been changed. Would you like to save changes?"

IF !THIS.lSaveBufferedData
	RETURN
ENDIF

LOCAL nDECursors, aDECursors, cDataEnvRef, lPromptSave,lHadPrompt
LOCAL lcAlias, lnFields, nPromptSave, i, loCurrentControl

* Flush current control
IF TYPE("THIS.ActiveControl.baseclass")="C" AND; 
  PEMSTATUS(THIS.ActiveControl,"value",5) AND;
  PEMSTATUS(THIS.ActiveControl,"controlsource",5) AND;
  !EMPTY(THIS.ActiveControl.controlsource)
	loCurrentControl = THIS.ActiveControl
	* Check if data actually changed
	IF !EVAL(loCurrentControl.controlsource)= loCurrentControl.Value
		loCurrentControl.Value = loCurrentControl.Value
	ENDIF
	loCurrentControl=""
ENDIF

nDECursors = 0
cDataEnvRef = ""
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"
CASE THIS.lUpdateAllBufferedTables
	nDECursors=AUSED(aDECursors)
OTHERWISE
	IF !EMPTY(ALIAS())
		aDECursors[1]=ALIAS()
		nDECursors=1
	ENDIF
ENDCASE

FOR i = 1 TO m.nDECursors
	IF EMPTY(m.cDataEnvRef)
		lcAlias = aDECursors[m.i]
	ELSE
		WITH EVAL(m.cDataEnvRef + "." + aDECursors[m.i])
			IF ATC("CURSOR",.BaseClass)=0  &&skip relations
				LOOP
			ENDIF
			lcAlias = .ALIAS
		ENDWITH
	ENDIF
	
	IF USED(lcAlias) AND CursorGetProp("sourcetype",lcAlias )=3 AND ;
	  CursorGetProp("buffering",lcAlias )>1

		IF !m.lHadPrompt
			IF CursorGetProp("buffering",lcAlias )>3
				IF GETNEXTMODIFIED(0,lcAlias )=0
					LOOP
				ENDIF
			ELSE
				lnFields = GETFLDSTATE(-1,lcAlias)
				IF REPLICATE("1",LEN(lnFields))=TRANS(lnFields)
					LOOP
				ENDIF
			ENDIF
			nPromptSave = MESSAGEBOX(PROMPTTOSAVE_LOC,35)
			IF nPromptSave=2
				RETURN .F.
			ENDIF
			lPromptSave=(nPromptSave=6)
			lHadPrompt = .T.
		ENDIF
	  	IF m.lPromptSave
			TableUpdate(.T.,.T.,lcAlias)  && update on exit
	  	ELSE
			TableRevert(.T.,lcAlias)  && update on exit
		ENDIF
	ENDIF
ENDFOR

ENDPROC
PROCEDURE deleterecord
#DEFINE MSGBOX_YES		6
#DEFINE C_MSGBOX1		36
#DEFINE C_DELETE_LOC	"Do you want to delete this record?"
LOCAL llHadEof
llHadEof=.F.
* Note: Cascading deletes should be handled via RI triggers in DBC!
IF !USED()
	RETURN
ENDIF

IF MESSAGEBOX(C_DELETE_LOC,C_MSGBOX1) = MSGBOX_YES
	DELETE
	DO WHILE DELETED() OR EOF()
		IF EOF()
			IF llHadEof
				EXIT
			ENDIF
			GO TOP
			llHadEof = .T.
		ELSE
			SKIP	
		ENDIF
	ENDDO
	THISFORM.Refresh
ENDIF

IF THISFORM.ShowWindow = 2
	Activate Window (THISFORM.Name)
ENDIF

ENDPROC
PROCEDURE Load
RETURN !THIS.HadError

ENDPROC
PROCEDURE QueryUnload
IF TYPE("THIS.APP_MEDIATOR.BaseClass")#"C"
	IF !THIS.ResolveConflicts()
		NODEFAULT
		RETURN .F.
	ENDIF
	RETURN
ENDIF

IF DODEFAULT()
    IF NOT THIS.App_Mediator.QueryUnload()
       NODEFAULT
       RETURN .F.
   ENDIF
ELSE
  NODEFAULT
  RETURN .F.
ENDIF

ENDPROC
PROCEDURE Show
LPARAMETERS nStyle
LOCAL lcAppRef

IF TYPE("THIS.APP_MEDIATOR.BaseClass")#"C" OR !THIS.lShowFirstTime
	RETURN
ENDIF

THIS.lShowFirstTime = .F.
THIS.lSaveBufferedData = .F.
THIS.PickRecord()

ENDPROC
PROCEDURE Error
#DEFINE ERR_UNIQUEKEY_LOC    "A unique key error violation has occurred."
#DEFINE ERR_UNIQUEKEY2_LOC   "Would you like to revert changes?"
#DEFINE ERR_TABLEINUSE_LOC   "Error: Table is in use. The table may already be opened exclusively."

LPARAMETERS nError, cMethod, nLine
LOCAL aFoxErr,nTotErr
DIMENSION aFoxErr[1]
nTotErr = AERROR(aFoxErr)
THIS.HadError = .T.

DO CASE
CASE INLIST(nError,1967)	&&errors to skip
	RETURN
CASE nToterr>0 AND aFoxErr[1,1] = 1420
	* Corrupt Ole object in General field.
	MESSAGEBOX(aFoxErr[1,2])
	RETURN
CASE nError = 5  &&record out of range
	IF EOF()
		GO BOTTOM
	ELSE
		GO TOP
	ENDIF
	RETURN
CASE nError = 1884
	* Uniqueness ID error
	IF CURSORGETPROP("buffering")=1
		MESSAGEBOX(ERR_UNIQUEKEY_LOC)
		RETURN
	ENDIF
	IF MESSAGEBOX(ERR_UNIQUEKEY_LOC+" "+ERR_UNIQUEKEY2_LOC,36)=6
		TABLEREVERT(.T.)
	ENDIF
	RETURN
CASE nError = 1995  &&table is in use
	MESSAGEBOX(ERR_TABLEINUSE_LOC)
	RETURN
ENDCASE

**** Error Dialog ******
MESSAGEBOX(MESSAGE(1)+CHR(13)+;
	"Error: "+STR(nError)+CHR(13)+;
	MESSAGE()+CHR(13)+;
	"Method: "+cMethod+CHR(13)+;
	"Line: "+STR(nLine))

ENDPROC
PROCEDURE Release
IF !THIS.Queryunload()
	NODEFAULT
	RETURN .F.
ENDIF

ENDPROC
�DataSession = 2
ScaleMode = 3
Height = 320
Width = 580
ShowWindow = 1
ScrollBars = 3
DoCreate = .T.
AutoCenter = .T.
Caption = "Form1"
Enabled = .T.
wizlayout = 
wizfield = 
wizmemo = 
wizlogic = 0
wizole = 
wizmaxcharfld = 0
wizlblsuffix = 0
wizlblcap = 0
wizformstretch = 0
wizlbldefwid = 0
wiztitle = 
wizuser = 0
wizgrid = 
wizverify = 0
wizbuttons = 0
wizbtnpos = 0
wizcodestyle = 0
wizbtnlayout = 0
wizcaptions = .T.
wizbuffering = 5
wizlabel = 
wizlblspace = 0
wizpages = 1
wizpagestyle = 
wizappclass = _formmediator
wizappclasslibrary = _framewk.vcx
wizappobject = app_mediator
lshowfirsttime = .T.
lpromptkey = .T.
lsavebuffereddata = .T.
Name = "baseform"
form