World Business - Telecommunication & Trade Directories PTC

home *** CD-ROM | disk | FTP | other *** search

/ World Business - Telecomm… & Trade Directories PTC / PTC3.iso / SETUP1.CAB / DMOVIE.APP (.txt) < prev next >

Wrap

MS Visual FoxPro App | 2000-02-24 | 440KB | 12,109 lines

dmovie DMOVIE MAINHWNDK _WHTOHWNDR _WONTOPY PLATFORM UNIQUEID TIMESTAMP CLASS CLASSLOC BASECLASS OBJNAME PARENT PROPERTIES PROTECTED METHODS OBJCODE RESERVED1 RESERVED2 RESERVED3 RESERVED4 RESERVED5 RESERVED6 RESERVED7 RESERVED8 COMMENT Screen WINDOWS _S2C1AGK0J 642297105 WINDOWS _S2C1AGK0K 676822574 WINDOWS _01I0XR9A7 676822432 WINDOWS _S2C1AGK0J 676822453 WINDOWS _SA60VGAC6 676822453 WINDOWS _S2C1AGK0J 676822432 WINDOWS _S2C1AGK0J 676822453_ WINDOWS _01B0ODN4U 676822453 WINDOWS _01I0X3II6 676822514 COMMENT RESERVED VERSION = 3.00 dataenvironment dataenvironment Dataenvironment Name = "Dataenvironment" Form1 ScaleMode = 3 Top = 20 Left = 38 Height = 380 Width = 420 ShowWindow = 1 DoCreate = .T. BorderStyle = 2 Caption = "Video" ControlBox = .F. Closable = .F. WindowType = 1 WindowState = 0 BackColor = 0,64,128 Name = "Form1" %PROCEDURE Activate ENDPROC Activate, shape shape Shape1 Form1 TTop = 24 Left = 36 Height = 265 Width = 349 SpecialEffect = 0 Name = "Shape1" commandbutton commandbutton Command1 Form1 AutoSize = .F. Top = 300 Left = 312 Height = 59 Width = 72 Picture = icons\dooropen.ico Caption = "Return" Name = "Command1" 2PROCEDURE Click thisform.release ENDPROC THISFORM RELEASE Click, commandbutton commandbutton Command7 Form1 tTop = 300 Left = 204 Height = 60 Width = 72 Picture = icons\msgbox01.ico Caption = "Pause" Name = "Command7" TPROCEDURE Click thisform.ivoclar.pausevideo thisform.kontron.pausevideo ENDPROC THISFORM IVOCLAR PAUSEVIDEO KONTRON Click, _videoplayer ..\..\klassen\_multimedia.vcx container kontron Form1 Top = 36 Left = 50 Width = 320 Height = 240 BackStyle = 1 Enabled = .F. Visible = .F. cfilename = (normalpfad+"movie\kontron1.avi") autoplay = .F. autorepeat = .F. Name = "kontron" tmrCheckMode.Name = "tmrCheckMode" commandbutton commandbutton Command2 Form1 tTop = 300 Left = 36 Height = 60 Width = 73 Picture = icons\arw01rt.ico Caption = "Kontron" Name = "Command2" PROCEDURE Click *thisform.video.cfilename=normalpfad+"movie\kontron1.avi" *!* thisform.video.closevideo() *!* thisform.video.cfilename="O:\ptccd\bmp\movie\kontron1.avi" *!* thisform.video.playvideo thisform.ivoclar.pausevideo thisform.kontron.pausevideo thisform.ivoclar.pausevideo thisform.kontron.pausevideo thisform.ivoclar.enabled=.t. thisform.ivoclar.visible=.t. thisform.kontron.enabled=.t. thisform.kontron.visible=.t. thisform.kontron.playvideo ENDPROC THISFORM IVOCLAR PAUSEVIDEO KONTRON ENABLED VISIBLE PLAYVIDEO Click, commandbutton commandbutton Command3 Form1 uTop = 300 Left = 120 Height = 60 Width = 73 Picture = icons\arw01rt.ico Caption = "Ivoclar" Name = "Command3" PROCEDURE Click *!* thisform.video.closevideo() *!* thisform.video.cfilename="O:\ptccd\bmp\movie\ivoclar.avi" *!* *thisform.video.cfilename=normalpfad+"movie\ivoclar.avi" *!* thisform.video.playvideo thisform.ivoclar.pausevideo thisform.kontron.pausevideo thisform.ivoclar.pausevideo thisform.kontron.pausevideo thisform.kontron.enabled=.f. thisform.kontron.visible=.f. thisform.ivoclar.enabled=.t. thisform.ivoclar.visible=.t. thisform.ivoclar.playvideo ENDPROC THISFORM IVOCLAR PAUSEVIDEO KONTRON ENABLED VISIBLE PLAYVIDEO Click, _videoplayer ..\..\klassen\_multimedia.vcx container ivoclar Form1 Top = 37 Left = 50 Width = 320 Height = 240 BackStyle = 1 SpecialEffect = 2 cfilename = (normalpfad+"movie\ivoclar.avi") autorepeat = .F. Name = "ivoclar" tmrCheckMode.Name = "tmrCheckMode" !Arial, 0, 9, 5, 15, 12, 16, 3, 0 wwwwpwwwwp wwwwwwwwwwwwwwp wwwwwwwwwwwwwwp wwwwww wwwwww PLATFORM UNIQUEID TIMESTAMP CLASS CLASSLOC BASECLASS OBJNAME PARENT PROPERTIES PROTECTED METHODS OBJCODE RESERVED1 RESERVED2 RESERVED3 RESERVED4 RESERVED5 RESERVED6 RESERVED7 RESERVED8 COMMENT Class WINDOWS _RA20UPS3F 612863321f WINDOWS _RA20XBHSA 612863321 COMMENT RESERVED WINDOWS _RA20UPS3F 612863328 WINDOWS _RA20XBHSA 609327833s COMMENT RESERVED VERSION = 3.00 _videoplayer getmcierror^ Pixels Class _container _videoplayer STATUS MODE stopped PARENT MCIALIAS DOMCI PLAYSOUND Timer, PROCEDURE Timer LOCAL cCmd cCmd = ("STATUS " + THIS.PARENT.MCIalias + " MODE") IF THIS.PARENT.doMCI(cCmd) = "stopped" THEN THIS.PARENT.playVideo ENDIF ENDPROC FTop = 96 Left = 120 Height = 23 Width = 23 Name = "tmrCheckMode" _videoplayer tmrCheckMode timer timer mcierror Specifies the result of the last MCI command executed. mcierrorstring Stores the error string from the last MCI command executed. autoopen Specifies whether the video file specified should be automatically opened when the class is created. mcialias Specifies the alias for the video file when calling MCI commands. If empty, the name of the file is used. autoplay Specifies whether the video file should automatically play after opening. autorepeat If .T., video will continuously play controlsource Specifies the source of data to which an object is bound. cfilename Specifies the video file associated with the Video Frame. *domci Executes a MCI command. *getmcierror Stores the last MCI error into properties of the class. *openvideo Opens the video file and shows it. *playvideo Plays the currently loaded video. *pausevideo Pauses a currently playing video. *showmcierror Displays the result of the last MCI command in a messagebox. *closevideo Closes the video file and releases all resources. *setposition Allows the user to set the position of the media file; Valid values are Start, End, or a number representing milliseconds. CMCICMD CRETSTRING NRETVALUE MCISENDSTRING GETMCIERROR cErrorb *ERROR* cErrorb CERROR NERROR CERRORSTRING MCIGETERRORSTRING MCIERROR MCIERRORSTRING! MCIERROR MCIERRORSTRING~ START STATUS length STATUS READY SEEK CPOSITION CALIAS NPOSITION CPOSCMD NMEDIALENGTH MCIALIAS DOMCIq No filename or control source specified! cFileName = ALLTRIM(&controlSource) STATUS READY CLOSE WAIT OPEN " " alias WAIT time format milliseconds CFILENAME CALIAS CONTROLSOURCE MCIALIAS MOUSEPOINTER DOMCI MCIERROR MCIERRORSTRING AUTOPLAY PLAYSOUND STATUS mode playing PAUSE CALIAS MCIALIAS DOMCI MCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODE INTERVAL! STATUS length STATUS position SEEK to start WAIT PLAY CALIAS NMEDIALENGTH NMEDIAPOSITION MCIALIAS DOMCI MCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODE INTERVAL STATUS READY CLOSE WAIT MCIALIAS DOMCI MCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODE INTERVAL opensound Invalid controlSource specified. NERROR CMETHOD NLINE# AUTOOPEN OPENSOUND mciSendString WinMM.DLL mciGetErrorString WINMM.DLL SetWindowPos User32 VISIBLE MCISENDSTRING WINMM MCIGETERRORSTRING SETWINDOWPOS USER32 CLOSESOUND domci, getmcierror showmcierrorW setposition opensoundp pausesoundg playsound| closesound ErrorH Refresh Init, Destroy STATUS MODE stopped PARENT MCIALIAS DOMCI PLAYVIDEO Timer, _base.vcx _base.vcx container Width = 33 Height = 36 BorderWidth = 0 Visible = .F. BackColor = 0,128,255 mcierror = 0 mcierrorstring = autoopen = .T. mcialias = autoplay = .T. autorepeat = .T. controlsource = cfilename = Name = "_soundplayer" timer Width = 201 Height = 133 BorderWidth = 0 Visible = .F. BackColor = 0,128,192 mcierror = 0 mcierrorstring = autoopen = .T. mcialias = autoplay = .T. autorepeat = .T. controlsource = cfilename = Name = "_videoplayer" container _soundplayer getmcierror^ Pixels Class _container _soundplayer timer tmrCheckMode _soundplayer Name = "tmrCheckMode" PROCEDURE Timer LOCAL cCmd cCmd = ("STATUS " + THIS.PARENT.MCIalias + " MODE") IF THIS.PARENT.doMCI(cCmd) = "stopped" THEN THIS.PARENT.playSound ENDIF ENDPROC amcierror Specifies the result of the last MCI command executed. mcierrorstring Stores the error string from the last MCI command executed. autoopen Specifies whether the sound file specified should be automatically opened when the class is created. mcialias Specifies the alias for the video file when calling MCI commands. If empty, the name of the file is used. autoplay Specifies whether the sound file should automatically play after opening. autorepeat If .T., sound will continuously play controlsource Specifies the source of data to which an object is bound. cfilename Sound file name to play. *domci Executes a MCI command. *getmcierror Stores the last MCI error into properties of the class. *showmcierror Displays the result of the last MCI command in a messagebox. *setposition Allows the user to set the position of the media file; Valid values are Start, End, or a number representing milliseconds. *opensound Opens the sound file. *pausesound Pauses the currently playing sound. *playsound Plays the loaded sound file. *closesound Closes the loaded sound file and releases it's resources. qPROCEDURE domci LPARAMETERS cMCIcmd LOCAL cRetString,nRetValue,cErr *!* This method takes a MCI command string and executes it using *!* the Windows API function mciSendString *!* If the function executes successfully, the result is returned. *!* Otherwise, the error string is returned. cRetString = space(80) nRetValue = mciSendString(cMCIcmd,@cRetString,len(cRetString),0) cErr = THIS.getMCIerror(nRetValue) IF nRetValue > 0 RETURN CeRR ENDIF RETURN TRIM(STRTRAN(cRetString,chr(0),"")) ENDPROC PROCEDURE getmcierror LPARAMETERS cError LOCAL nError,cErrorString *!* This method is called from the doMCI to retrieve the last *!* MCI error string. *!* This function also saves the last error number and string *!* into properties associated with the form. nError=0 IF TYPE("cError")="C" IF LEFT(cError,7)="*ERROR*" nError=val(substr(cError,8)) ENDIF ENDIF IF TYPE("cError")="N" nError=cError ENDIF cErrorString=SPACE(256) =mciGetErrorString(nError,@cErrorString,len(cErrorString)) THIS.MCIerror = nError THIS.MCIerrorString = cErrorString RETURN TRIM(CHRTRAN(cErrorString,CHR(0),"")) ENDPROC PROCEDURE showmcierror MESSAGEBOX(STR(THIS.MCIerror) + ": " + THIS.MCIerrorString) ENDPROC PROCEDURE setposition PARAMETERS cPosition LOCAL cAlias,nPosition,cPosCmd,nMediaLength,cCmd cAlias = THIS.MCIalias IF UPPER(cPosition) = "START" or UPPER(cPosition) = "END" THEN cPosCmd = "to " + cPosition nPosition = VAL(cPosition) IF EMPTY(nPosition) THEN RETURN ELSE *!* Check to make sure position is not greater than the length nMediaLength = VAL(THIS.doMCI("STATUS " + cAlias + " length")) IF nMediaLength < nPosition THEN RETURN ELSE cPosCmd = "to " + STR(nPosition) ENDIF ENDIF ENDIF *!* Make sure video is loaded cCmd = ("STATUS " + cAlias + " READY") IF THIS.doMCI(cCmd) = "true" THEN cCmd = "SEEK " + cAlias + " " + cPosCmd THIS.doMCI(cCmd) ENDIF ENDPROC PROCEDURE opensound #DEFINE C_NOFILENAME_LOC "No filename or control source specified!" LOCAL cFileName,cAlias,cCmd *!* Get needed properties into variables IF EMPTY(THIS.controlSource) THEN cFileName = THIS.cFileName IF EMPTY(cFileName) THEN MESSAGEBOX(C_NOFILENAME_LOC) RETURN ENDIF cFileName = ALLTRIM(&controlSource) IF EMPTY(cFileName) THEN RETURN ENDIF ENDIF cAlias = THIS.MCIalias IF EMPTY(cAlias) THEN cAlias = THIS.name THIS.MCIalias = cAlias ENDIF _SCREEN.MousePointer = 11 *!* If sound is already loaded, then close it cCmd = ("STATUS " + cAlias + " READY") IF THIS.doMCI(cCmd) = "true" THEN *!* If one is, close it cCMD = ("CLOSE " + cAlias + " WAIT") THIS.doMCI(cCmd) ENDIF *!* Set up open MCI command into string variable cCmd = ('OPEN "' + cFileName + '" alias ' + cAlias + ' WAIT') THIS.doMCI(cCmd) *!* Check to see if MCI command succeeded IF THIS.MCIerror > 0 THEN messagebox(THIS.MCIerrorString) _SCREEN.MousePointer = 0 RETURN ENDIF *!* Set the device to use milliseconds when setting/getting position THIS.doMCI("SET " + cAlias + " time format milliseconds") IF THIS.autoPlay = .T. THEN THIS.playSound ENDIF _SCREEN.MousePointer = 0 ENDPROC PROCEDURE pausesound LOCAL cAlias cAlias = THIS.MCIalias *!* Check to see if there is media acutally playing IF THIS.doMCI("STATUS " + cAlias + " mode") = "playing" THEN *!* Yes there is, so execute the PAUSE MCI command THIS.doMCI("PAUSE " + cAlias) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 0 ENDIF ENDIF ENDPROC PROCEDURE playsound LOCAL cAlias,nMediaLength,nMediaPosition cAlias = THIS.MCIalias *!* First need to see if the media is at the end *!* by comparing the total length with the current position nMediaLength = VAL(THIS.doMCI("STATUS " + cAlias + " length")) nMediaPosition = VAL(THIS.doMCI("STATUS " + cAlias + " position")) IF nMediaPosition >= nMediaLength THEN *!* The media is at the end, so we need to seek back to the start *!* of the clip before playing THIS.doMCI("SEEK " + cAlias + " to start WAIT") ENDIF *!* Now we can play the media THIS.doMCI("PLAY " + cAlias) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 300 ENDIF ENDPROC PROCEDURE closesound *!* If sound is not already closed, then close it LOCAL cCmd cCmd = ("STATUS " + THIS.MCIalias + " READY") IF THIS.doMCI(cCmd) = "true" THEN *!* If one is, close it cCMD = ("CLOSE " + THIS.MCIalias + " WAIT") THIS.doMCI(cCmd) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 0 ENDIF ENDIF ENDPROC PROCEDURE Error #DEFINE INVALID_CONTROLSOURCE_LOC "Invalid controlSource specified." LPARAMETERS nError, cMethod, nLine DO CASE CASE nError=12 AND cMethod="opensound" messageBox(INVALID_CONTROLSOURCE_LOC) OTHERWISE ERROR (nError) ENDCASE ENDPROC PROCEDURE Refresh IF THIS.autoOpen = .T. THEN THIS.openSound ENDIF ENDPROC PROCEDURE Init THIS.Visible = .F. *!* This is the primary Windows API function that is used to *!* send MCI commands DECLARE INTEGER mciSendString ; IN WinMM.DLL ; STRING cMCIString,; STRING @cRetString,; INTEGER nRetLength,; INTEGER hInstance *!* This function allows us to retrieve the last MCI error that occured DECLARE INTEGER mciGetErrorString ; IN WINMM.DLL ; INTEGER nErrorno, ; STRING @cBuffer, ; INTEGER nBufSize *!* When MCI plays a video, it creates its own Window. By using *!* this Windows API function we can position this Window to be *!* in the same position as our Player rectangle on the form DECLARE integer SetWindowPos ; IN User32 ; integer, integer, integer, integer, integer, integer, integer ENDPROC PROCEDURE Destroy THIS.closeSound ENDPROC \PROCEDURE domci LPARAMETERS cMCIcmd LOCAL cRetString,cErr,nRetValue *!* This method takes a MCI command string and executes it using *!* the Windows API function mciSendString *!* If the function executes successfully, the result is returned. *!* Otherwise, the error string is returned. cRetString = space(80) nRetValue = mciSendString(cMCIcmd,@cRetString,len(cRetString),0) cErr = THIS.getMCIerror(nRetValue) IF nRetValue > 0 RETURN CeRR ENDIF RETURN TRIM(STRTRAN(cRetString,chr(0),"")) ENDPROC PROCEDURE getmcierror LPARAMETERS cError LOCAL nError,cErrorString *!* This method is called from the doMCI to retrieve the last *!* MCI error string. *!* This function also saves the last error number and string *!* into properties associated with the form. nError=0 IF TYPE("cError")="C" IF LEFT(cError,7)="*ERROR*" nError=val(substr(cError,8)) ENDIF ENDIF IF TYPE("cError")="N" nError=cError ENDIF cErrorString=SPACE(256) =mciGetErrorString(nError,@cErrorString,len(cErrorString)) THIS.MCIerror = nError THIS.MCIerrorString = cErrorString RETURN TRIM(CHRTRAN(cErrorString,CHR(0),"")) ENDPROC PROCEDURE openvideo #DEFINE C_NOFILENAME_LOC "No filename specified or control source specified!" LOCAL cControlSource,cFileName,cAlias,cCmd,hWin,Main_hWnd,cur_window LOCAL x1Pos,x2Pos,y1Pos,y2Pos,NullPointer *!* Get needed properties into variables cControlSource = THIS.controlSource IF EMPTY(cControlSource) THEN cFileName = THIS.cFileName IF EMPTY(cFileName) THEN MESSAGEBOX(C_NOFILENAME_LOC) RETURN ENDIF cFileName = ALLTRIM(&cControlSource) IF EMPTY(cFileName) THEN RETURN ENDIF ENDIF cAlias = THIS.MCIalias IF EMPTY(cAlias) THEN cAlias = THIS.name THIS.MCIalias = cAlias ENDIF _SCREEN.MousePointer = 11 *!* If video is already loaded, then close it cCmd = ("STATUS " + cAlias + " READY") IF THIS.doMCI(cCmd) = "true" THEN *!* If one is, close it cCMD = ("CLOSE " + cAlias + " WAIT") THIS.doMCI(cCmd) ENDIF *!* Need to use window handle functions in FoxTools SET LIBRARY TO HOME() + ".\FOXTOOLS.FLL" EXTERNAL PROCEDURE MainHWND EXTERNAL PROCEDURE _WhToHwnd EXTERNAL PROCEDURE _WOnTop * Returns Handle of Main VFP Window Main_hWnd = MainHWND() * Get Handle of the form with FOXTOOLS.FLL cur_window = _WhToHwnd(_WOnTop()) NullPointer = 0 *!* Set up open MCI command into string variable cCmd = ('OPEN "' + cFileName + '" alias ' + cAlias + ; ' style child parent ' + ALLTRIM(STR(cur_window)) + ' WAIT') THIS.doMCI(cCmd) *!* Check to see if MCI command succeeded IF THIS.MCIerror > 0 THEN messagebox(THIS.MCIerrorString) _SCREEN.MousePointer = 0 RETURN *!* It does have visual media, so we need to set up the window *!* it will play in. *!* Get the window handle of the window playing the video cCmd = "status " + cAlias + " window handle wait" hWin = INT(VAL(THIS.doMCI(cCmd))) *!* Once we have the window handle, we need to position *!* the video window to be the same position and size *!* as our player rectangle on the form x1Pos = THIS.LEFT y1Pos = THIS.TOP x2Pos = THIS.WIDTH y2Pos = THIS.HEIGHT *!* Use the SetWindowPos Windows function to set position and size setWindowPos(hWin,0,x1Pos,y1Pos,x2Pos,y2Pos,0) *!* Everything's done, let's show the video cCmd = ("WINDOW " + cAlias + " state show") THIS.doMCI(cCmd) ENDIF *!* Set the device to use milliseconds when setting/getting position THIS.doMCI("SET " + cAlias + " time format milliseconds") IF THIS.autoPlay = .T. THEN THIS.playVideo ENDIF _SCREEN.MousePointer = 0 ENDPROC PROCEDURE playvideo LOCAL cAlias,nMediaLength,nMediaPosition cAlias = THIS.MCIalias *!* First need to see if the media is at the end *!* by comparing the total length with the current position nMediaLength = VAL(THIS.doMCI("STATUS " + cAlias + " length")) nMediaPosition = VAL(THIS.doMCI("STATUS " + cAlias + " position")) IF nMediaPosition >= nMediaLength THEN *!* The media is at the end, so we need to seek back to the start *!* of the clip before playing THIS.doMCI("SEEK " + cAlias + " to start WAIT") ENDIF *!* Now we can play the media THIS.doMCI("PLAY " + cAlias) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 100 ENDIF ENDPROC PROCEDURE pausevideo LOCAL cAlias cAlias = THIS.MCIalias *!* Check to see if there is media acutally playing IF THIS.doMCI("STATUS " + cAlias + " mode") = "playing" THEN *!* Yes there is, so execute the PAUSE MCI command THIS.doMCI("PAUSE " + cAlias) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 0 ENDIF ENDIF ENDPROC PROCEDURE showmcierror MESSAGEBOX(STR(THIS.MCIerror) + ": " + THIS.MCIerrorString) ENDPROC PROCEDURE closevideo LOCAL cCmd *!* If video is not already closed, then close it cCmd = ("STATUS " + THIS.MCIalias + " READY") IF THIS.doMCI(cCmd) = "true" THEN *!* If one is, close it cCMD = ("CLOSE " + THIS.MCIalias + " WAIT") THIS.doMCI(cCmd) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 0 ENDIF ENDIF ENDPROC PROCEDURE setposition PARAMETERS cPosition LOCAL cAlias,cPosCmd,nPosition,nMediaLength cAlias = THIS.MCIalias IF UPPER(cPosition) = "START" or UPPER(cPosition) = "END" THEN cPosCmd = "to " + cPosition nPosition = VAL(cPosition) IF EMPTY(nPosition) THEN RETURN ELSE *!* Check to make sure position is not greater than the length nMediaLength = VAL(THIS.doMCI("STATUS " + cAlias + " length")) IF nMediaLength < nPosition THEN RETURN ELSE cPosCmd = "to " + STR(nPosition) ENDIF ENDIF ENDIF *!* Make sure video is loaded cCmd = ("STATUS " + cAlias + " READY") IF THIS.doMCI(cCmd) = "true" THEN cCmd = "SEEK " + cAlias + " " + cPosCmd THIS.doMCI(cCmd) ENDIF ENDPROC PROCEDURE Destroy THIS.closeVideo ENDPROC PROCEDURE Init THIS.Visible = .F. *!* This is the primary Windows API function that is used to *!* send MCI commands DECLARE INTEGER mciSendString ; IN WinMM.DLL ; STRING cMCIString,; STRING @cRetString,; INTEGER nRetLength,; INTEGER hInstance *!* This function allows us to retrieve the last MCI error that occured DECLARE INTEGER mciGetErrorString ; IN WINMM.DLL ; INTEGER nErrorno, ; STRING @cBuffer, ; INTEGER nBufSize *!* When MCI plays a video, it creates its own Window. By using *!* this Windows API function we can position this Window to be *!* in the same position as our Player rectangle on the form DECLARE integer SetWindowPos ; IN User32 ; integer, integer, integer, integer, integer, integer, integer ENDPROC PROCEDURE Refresh IF THIS.autoOpen = .T. THEN THIS.openVideo ENDIF ENDPROC PROCEDURE Error #DEFINE INVALID_CONTROLSOURCE_LOC "Invalid controlSource specified." LPARAMETERS nError, cMethod, nLine DO CASE CASE nError = 12 and cMethod = "openvideo" messageBox(INVALID_CONTROLSOURCE_LOC) OTHERWISE ERROR (nError) ENDCASE ENDPROC CMCICMD CRETSTRING CERR NRETVALUE MCISENDSTRING GETMCIERROR cErrorb *ERROR* cErrorb CERROR NERROR CERRORSTRING MCIGETERRORSTRING MCIERROR MCIERRORSTRING7 No filename specified or control source specified! cFileName = ALLTRIM(&cControlSource) STATUS READY CLOSE WAIT .\FOXTOOLS.FLL MainHWND _WhToHwnd _WOnTop OPEN " " alias style child parent WAIT status window handle wait WINDOW state show time format milliseconds CCONTROLSOURCE CFILENAME CALIAS HWIN MAIN_HWND CUR_WINDOW X1POS X2POS Y1POS Y2POS NULLPOINTER CONTROLSOURCE MCIALIAS MOUSEPOINTER DOMCI MAINHWND _WHTOHWND _WONTOP MCIERROR MCIERRORSTRING WIDTH HEIGHT SETWINDOWPOS AUTOPLAY PLAYVIDEO STATUS length STATUS position SEEK to start WAIT PLAY CALIAS NMEDIALENGTH NMEDIAPOSITION MCIALIAS DOMCI MCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODE INTERVAL STATUS mode playing PAUSE CALIAS MCIALIAS DOMCI MCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODE INTERVAL! MCIERROR MCIERRORSTRING STATUS READY CLOSE WAIT MCIALIAS DOMCI MCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODE INTERVALz START STATUS length STATUS READY SEEK CPOSITION CALIAS CPOSCMD NPOSITION NMEDIALENGTH MCIALIAS DOMCI CLOSEVIDEO mciSendString WinMM.DLL mciGetErrorString WINMM.DLL SetWindowPos User32 VISIBLE MCISENDSTRING WINMM MCIGETERRORSTRING SETWINDOWPOS USER32# AUTOOPEN OPENVIDEO openvideo Invalid controlSource specified. NERROR CMETHOD NLINE domci, getmcierror openvideoW playvideo pausevideoM showmcierrorb closevideo setposition Destroy Refresh Error PLATFORM UNIQUEID TIMESTAMP CLASS CLASSLOC BASECLASS OBJNAME PARENT PROPERTIES PROTECTED METHODS OBJCODE RESERVED1 RESERVED2 RESERVED3 RESERVED4 RESERVED5 RESERVED6 RESERVED7 RESERVED8 COMMENT Class WINDOWS _RFH0TJIMM 560754145u COMMENT RESERVED WINDOWS _RFH0TJUI1 560754153A COMMENT RESERVED WINDOWS _RFH0TK41Y 560754159o COMMENT RESERVED WINDOWS _RFH0TKWGH 560754179 COMMENT RESERVED WINDOWS _RFH0TL694 560754185 COMMENT RESERVED WINDOWS _RFH0TM5BE 560754210 COMMENT RESERVED WINDOWS _RFH0TN1LS 560754231V COMMENT RESERVED WINDOWS _RFH0TO4SH 560754258j COMMENT RESERVED WINDOWS _RFH0TOFY3 560754266 COMMENT RESERVED WINDOWS _RFH0TORHM 560754275i COMMENT RESERVED WINDOWS _RFH0TP4MN 560754283 COMMENT RESERVED WINDOWS _RFH0TQPLW 560754322 COMMENT RESERVED WINDOWS _RFH0TQZT5 560754329 COMMENT RESERVED WINDOWS _RFH0TRAT8 560754338? COMMENT RESERVED WINDOWS _RFH0TRNAK 560754346r COMMENT RESERVED WINDOWS _RFH0TRWLB 560754352a COMMENT RESERVED WINDOWS _RFH0TSAN0 560754361 COMMENT RESERVED WINDOWS _RFH0TMNOX 560756119 WINDOWS _RFH0TMNQY 560754222Y COMMENT RESERVED WINDOWS _RKG0Z8AU6 581534552 COMMENT RESERVED WINDOWS _RKG0Z69ZT 581925859 COMMENT RESERVED WINDOWS _RFH0TNO1H 582252775J COMMENT RESERVED WINDOWS _RML0XWL1D 586776102 COMMENT RESERVED WINDOWS _RFH0TNH5N 592012320r COMMENT RESERVED WINDOWS _RSL0XGTQR 609778861c COMMENT RESERVED WINDOWS _RFH0TMEE8 610442374 COMMENT RESERVED WINDOWS _RFH0TSJRX 610442376 COMMENT RESERVED WINDOWS _RFH0TLOXD 611583448< COMMENT RESERVED VERSION = 3.00 _label Pixels Class label _label label _hyperlink Pixels _custom addtoproject Pixels Foundation Custom class. _grid checkbox Pixels Class hyperlink activedoc optiongroup _checkbox checkbox Class Pixels _checkbox !Arial, 0, 9, 5, 15, 12, 13, 3, 0 pageframe hyperlink _hyperlink !Arial, 0, 9, 5, 15, 12, 13, 3, 0 Class _grid _optiongroup optiongroup Class !Arial, 0, 9, 5, 15, 12, 13, 3, 0 _imageox addtoproject Pixels _combobox !Arial, 0, 9, 5, 15, 12, 13, 3, 0 Class formset _formset +PROCEDURE Release RELEASE this ENDPROC _pageframe separator _separator Class _formset Form1 Pixels !Arial, 0, 9, 5, 15, 12, 13, 3, 0 _form addtoproject Pixels commandbutton Class separator Pixels _separator shape Pixels _commandbutton commandbutton Class Pixels _commandbutton !Arial, 0, 9, 5, 15, 12, 13, 3, 0 _activedoc activedoc Class !Arial, 0, 9, 5, 15, 12, 13, 3, 0 _editbox Pixels Class editbox _editbox !Arial, 0, 9, 5, 15, 12, 13, 3, 0 Class editbox listbox _listbox _spinner _image formset _optionbutton optionbutton _optionbutton _shape _optiongroup Pixels _container Pixels Class container commandgroup _container addtoproject Pixels Class spinner Pixels _spinner Class Class Pixels _projecthook projecthook _projecthook projecthook textbox Class !Arial, 0, 9, 5, 15, 12, 13, 3, 0 _listbox Pixels Class _commandgroup commandgroup Class Pixels _commandgroup !Arial, 0, 9, 5, 15, 12, 13, 3, 0 optionbutton shape Class container _toolbar addtoproject Pixels Class !Arial, 0, 9, 5, 15, 12, 13, 3, 0 toolbar _timer Pixels Pixels _shape spinner _line image Class Pixels _line Class timer _timer Class Pixels _activedoc timer !Arial, 0, 9, 5, 15, 12, 13, 3, 0 _textbox Pixels Class textbox _textbox listbox !Arial, 0, 9, 5, 15, 12, 13, 3, 0 Release, Foundation Toolbar class. Foundation Timer class. Foundation TextBox class. Foundation Spinner class. Foundation Shape class. Foundation Separator class. Foundation ProjectHook class. Foundation PageFrame class. Foundation OptionGroup class. Foundation OptionButton class. Foundation Listbox class. Foundation Line class. addtoproject _toolbar toolbar control _control control image Class Pixels _control addtoproject addtoproject addtoproject addtoproject addtoproject addtoproject Foundation Form class. _form Foundation ActiveDoc class. Foundation CheckBox class. Foundation ComboBox class. Foundation CommandButton class. Foundation CommandGroup class. Foundation Container class. custom _custom custom Foundation Label class. Foundation Image class. Foundation Hyperlink class. Foundation Grid class. Foundation FormSet class. Foundation EditBox class. addtoproject addtoproject addtoproject addtoproject addtoproject addtoproject addtoproject addtoproject addtoproject addtoproject addtoproject addtoproject addtoproject addtoproject addtoproject Caption = "Toolbar1" ShowWindow = 1 cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Name = "_toolbar" ShowWindow = 1 DoCreate = .T. Caption = "Form1" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Name = "_form" Height = 22 Width = 24 cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Name = "_control" Height = 68 Width = 68 cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Name = "_image" Height = 68 Width = 68 Name = "_projecthook" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Caption = "Label1" Height = 16 Width = 40 Name = "_label" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Height = 23 Width = 23 Name = "_hyperlink" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Height = 68 Width = 68 Name = "_activedoc" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") DoCreate = .T. Caption = "Form1" Name = "Form1" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Name = "_formset" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Height = 23 Width = 23 Name = "_timer" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Height = 23 Width = 100 Name = "_textbox" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Height = 24 Width = 100 Name = "_combobox" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Height = 24 Width = 120 Name = "_spinner" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Height = 68 Width = 68 Name = "_shape" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Height = 0 Width = 0 Name = "_separator" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") ErasePage = .T. PageCount = 2 Width = 241 Height = 169 Name = "_pageframe" Page1.Caption = "Page1" Page1.Name = "Page1" Page2.Caption = "Page2" Page2.Name = "Page2" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") AButtonCount = 2 Value = 1 Height = 46 Width = 71 Name = "_optiongroup" Option1.Caption = "Option1" Option1.Value = 1 Option1.Height = 17 Option1.Left = 5 Option1.Top = 5 Option1.Width = 61 Option1.Name = "Option1" Option2.Caption = "Option2" Option2.Height = 17 Option2.Left = 5 Option2.Top = 24 Option2.Width = 61 Option2.Name = "Option2" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") !Caption = "Option1" Height = 17 Width = 61 Name = "_optionbutton" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Height = 170 Width = 100 Name = "_listbox" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Height = 68 Width = 68 Name = "_line" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Height = 200 Width = 320 Name = "_grid" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Height = 53 Width = 100 Name = "_editbox" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign Width = 200 Height = 200 Name = "_container" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Height = 22 Width = 24 cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") ninstances = 0 Name = "_custom" #Height = 27 Width = 84 Caption = "Command1" Name = "_commandbutton" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign AButtonCount = 2 Value = 1 Height = 66 Width = 94 Name = "_commandgroup" Command1.Top = 5 Command1.Left = 5 Command1.Height = 27 Command1.Width = 84 Command1.Caption = "Command1" Command1.Name = "Command1" Command2.Top = 34 Command2.Left = 5 Command2.Height = 27 Command2.Width = 84 and2.Caption = "Command2" Command2.Name = "Command2" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") Height = 17 Width = 60 Caption = "Check1" Name = "_checkbox" cversion = builder = builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") nobjectrefcount = 0 ninstances = 0 ohost = .NULL. vresult = .T. csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC cversion Version property. builder Bulder property. builderx BuilderX property. lautobuilder Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. nobjectrefcount Returns the number of items in the object reference array property aObjectRefs. ohost Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. lautosetobjectrefs Specifiies if the SetObjectRefs method is automatically called from the Init method. vresult Variant result property for internal usage when calling programs in PRGs and a return file is required. lrelease Indicates the object's Release method has been executed and the object is in the process of being released from memory. csetobjrefprogram Program to be called when when setting an object references via the SetObjectRef method. lignoreerrors Specifies if the default FFC error handler is executed when an error occurs. lsethost Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. ninstances *release Releases object from memory. *setobjectref Set object reference to specific property. *setobjectrefs Place holder method for listing SetObjectRef method calls. *releaseobjrefs Releases all object references of aObjectRefs array. *nobjectrefcount_access Access method for nObjectRefCount property. *nobjectrefcount_assign Assign method for nObjectRefCount property. ^aobjectrefs[1,3] Array of object references properties. *sethost Set oHost property to form reference object. *newinstance Returns new instance of object. *addtoproject Dummy code for adding files to project. *ninstances_access *ninstances_assign IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC IPROCEDURE release LOCAL lcBaseClass IF this.lRelease NODEFAULT RETURN .F. ENDIF this.lRelease=.T. lcBaseClass=LOWER(this.BaseClass) this.oHost=.NULL. this.ReleaseObjRefs IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") RELEASE this ENDIF ENDPROC PROCEDURE setobjectref LPARAMETERS tcName,tvClass,tvClassLibrary LOCAL lvResult this.vResult=.T. DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) lvResult=this.vResult this.vResult=.T. RETURN lvResult ENDPROC PROCEDURE setobjectrefs LPARAMETERS toObject RETURN ENDPROC PROCEDURE releaseobjrefs LOCAL lcName,oObject,lnCount IF this.nObjectRefCount=0 RETURN ENDIF FOR lnCount = this.nObjectRefCount TO 1 STEP -1 lcName=this.aObjectRefs[lnCount,1] IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" LOOP ENDIF oObject=this.&lcName IF ISNULL(oObject) LOOP ENDIF IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) oObject.Release ENDIF IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) oObject.oHost=.NULL. ENDIF this.&lcName=.NULL. oObject=.NULL. ENDFOR DIMENSION this.aObjectRefs[1,3] this.aObjectRefs="" ENDPROC PROCEDURE nobjectrefcount_access LOCAL lnObjectRefCount lnObjectRefCount=ALEN(this.aObjectRefs,1) IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) lnObjectRefCount=0 ENDIF RETURN lnObjectRefCount ENDPROC PROCEDURE nobjectrefcount_assign LPARAMETERS m.vNewVal ERROR 1743 ENDPROC PROCEDURE sethost this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) ENDPROC PROCEDURE newinstance LPARAMETERS tnDataSessionID LOCAL oNewObject,lnLastDataSessionID lnLastDataSessionID=SET("DATASESSION") IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 SET DATASESSION TO tnDataSessionID ENDIF oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) SET DATASESSION TO (lnLastDataSessionID) RETURN oNewObject ENDPROC PROCEDURE addtoproject *-- Dummy code for adding files to project. RETURN DO SetObjRf.prg ENDPROC PROCEDURE ninstances_access LOCAL laInstances[1] RETURN AINSTANCE(laInstances,this.Class) ENDPROC PROCEDURE ninstances_assign LPARAMETERS vNewVal ERROR 1743 ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg IF this.lIgnoreErrors RETURN .F. ENDIF lcOnError=UPPER(ALLTRIM(ON("ERROR"))) IF NOT EMPTY(lcOnError) lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; "PROGRAM()","cMethod"),"LINENO()","nLine") &lcOnError RETURN ENDIF lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; "Method: "+LOWER(ALLTRIM(cMethod)) lcCodeLineMsg=MESSAGE(1) IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) IF NOT EMPTY(lcCodeLineMsg) lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg ENDIF ENDIF WAIT CLEAR MESSAGEBOX(lcErrorMsg,16,_screen.Caption) ERROR nError ENDPROC PROCEDURE Init IF this.lSetHost this.SetHost ENDIF IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF this.lRelease RETURN .F. ENDIF this.lRelease=.T. this.ReleaseObjRefs this.oHost=.NULL. ENDPROC form formset toolbar LCBASECLASS LRELEASE BASECLASS OHOST RELEASEOBJREFSw TCNAME TVCLASS TVCLASSLIBRARY LVRESULT VRESULT CSETOBJREFPROGRAM TOOBJECT this. oObject=this.&lcName oObjectb Release oHost this.&lcName=.NULL. LCNAME OOBJECT LNCOUNT NOBJECTREFCOUNT AOBJECTREFS RELEASE OHOSTZ LNOBJECTREFCOUNT AOBJECTREFS VNEWVAL. thisformb OHOST THISFORM DATASESSIONv tnDataSessionIDb TNDATASESSIONID ONEWOBJECT LNLASTDATASESSIONID CLASS CLASSLIBRARY SetObjRf.prg SETOBJRF LAINSTANCES CLASS VNEWVAL ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError Error: Method: Line: NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG LIGNOREERRORS CAPTIONL LSETHOST SETHOST LAUTOSETOBJECTREFS SETOBJECTREFSD LRELEASE RELEASEOBJREFS OHOST release, setobjectref setobjectrefs releaseobjrefs nobjectrefcount_access nobjectrefcount_assigni sethost newinstance addtoproject ninstances_access ninstances_assign/ ErrorP Destroy+ toObjectb tcNameb tvClassb tvClassLibraryb tvClassLibraryb oObjectb oHost oHost TOOBJECT TCNAME TVCLASS TVCLASSLIBRARY LCNAME LCCLASS LCCLASSLIBRARY OOBJECT LNCOUNT LNOBJECTREFINDEX LNOBJECTREFCOUNT OEXISTINGOBJECT CLASS CLASSLIBRARY VRESULT LLCLASSLIB ADDPROPERTY OHOST NOBJECTREFCOUNT AOBJECTREFS; PLATFORM UNIQUEID TIMESTAMP CLASS CLASSLOC BASECLASS OBJNAME PARENT PROPERTIES PROTECTED METHODS OBJCODE RESERVED1 RESERVED2 RESERVED3 RESERVED4 RESERVED5 RESERVED6 RESERVED7 RESERVED8 COMMENT Class 0 WINDOWS _QYC0Z5IUF 510165763 WINDOWS _QYC0Z5J6Y 510165763J WINDOWS _QYC0Z5Q47 510165767J WINDOWS _QYC0Z5QD3 510165768 WINDOWS _R460NOG7P 524572762 WINDOWS _R460NOFRA 524572762~ WINDOWS _R460NOFWK 524572762t WINDOWS _R460NOG3T 524572762d COMMENT FONTINFO WINDOWS _R5S0NGX66 528570144 COMMENT FONTINFO WINDOWS _R5W118DH0 528845512 COMMENT FONTINFO WINDOWS _R6Y0ZX7R5 539657649o COMMENT FONTINFO WINDOWS _R6Y10LAOW 539658377 COMMENT FONTINFO WINDOWS _R9219M9N8 544910295 WINDOWS _R921A3YPB 544910295 WINDOWS _R921A3ZBJ 544910295U WINDOWS _QTZ0WOH2H 544910296 WINDOWS _R921A40N9 544910296 WINDOWS _R921A41IR 544910297 COMMENT RESERVED WINDOWS _R8C0U0LVK 547849277. WINDOWS _R8C0U0LQK 5478492777 WINDOWS _R8C0U0LRO 547849277 WINDOWS _R8C0U0LT2 547849277 WINDOWS _R8C0U0LTM 547849277 WINDOWS _R8C0U0LUG 547849277[ WINDOWS _R8C0U0LV0 547849277B COMMENT RESERVED WINDOWS _R2Z0NXWN8 547968551) WINDOWS _R2Z0NXWA5 547968481 WINDOWS _QYC0Z5IUF 547968551t WINDOWS _R2Z0NXWEL 547968551 WINDOWS _R2Z0NXWCR 547968551C WINDOWS _R2Z0NXWGG 547968551< WINDOWS _R2Z0NXWLH 5479685511 COMMENT RESERVED WINDOWS _R5Z0WREFN 548045785 COMMENT RESERVED WINDOWS _RBF0YPT02 550786818 WINDOWS _RBF0YPT2X 550732153J WINDOWS _RBF0YPT8K 550786818 WINDOWS _RBF0YPTAV 550732337 WINDOWS _RBF0YPTCF 550786818h WINDOWS _RBF0YPTDR 550786732; WINDOWS _RBF0YPTIA 550732153 WINDOWS _RBF0YPTK8 550734210 WINDOWS _RBF10JQ8T 550786818 COMMENT RESERVED WINDOWS _R940Q8XD5 550798728G COMMENT RESERVED WINDOWS _R940NBEGO 550798730 COMMENT RESERVED WINDOWS _RBG10MVKG 550800274k WINDOWS _RBG10R8XR 550800274K WINDOWS _RBG10R910 550800077 WINDOWS _RBG10R93V 550799644 COMMENT RESERVED WINDOWS _RA20UPS3F 552362375 WINDOWS _RA20XBHSA 547509048i COMMENT RESERVED WINDOWS _R6Y10O0I3 616212987 WINDOWS _R6Y10NZNS 616212987 WINDOWS _R6Y10NZRZ 616212987 WINDOWS _R6Y10NZUG 616212987g WINDOWS _R6Y10NZYZ 616212987 WINDOWS _R6Y10O004 616212987 WINDOWS _R6Y10O03V 616212987 WINDOWS _R6Y10O07H 616212987Q WINDOWS _R6Y10O0C3 616212987% WINDOWS _R6Y10O0D6 616212987 COMMENT RESERVED WINDOWS _RA20UPS3F 662194010# WINDOWS _RA20XBHSA 547454261 COMMENT RESERVED VERSION = 0.029 cmdColor commandbutton} commandbutton Top = 4 Left = 255 Height = 23 Width = 25 FontBold = .T. FontItalic = .T. FontName = "Courier New" FontSize = 9 Caption = "K" ToolTipText = "Kursiv" Name = "cmdItalic" rtfcontrols. cmdItalic commandbutton commandbuttonU Top = 4 Left = 227 Height = 23 Width = 25 FontBold = .T. FontName = "Courier New" Caption = "F" ToolTipText = "Fett" Name = "cmdBold" rtfcontrols. cmdBold commandbuttonP commandbutton ,Left = 172 Top = 4 Name = "Cbofontsize1" rtfcontrols.W Cbofontsize1 combobox videoframe getmcierror^ Pixels Class control QMS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 Courier New, 1, 11, 9, 17, 12, 10, 5, 0 moverlists Pixels moverbox.bmp moverbox.bmp mover list boxes Class container moverlists ENABLED THISFORM REFRESH Click, soundplayer getmcierror^ FfU)-s Pixels PROCEDURE Click THISFORM.LockScreen = .T. FOR i = 1 to THIS.Parent.lstSelected.ListCount THIS.Parent.lstSource.AddItem(THIS.Parent.lstSelected.List(i)) ENDFOR THIS.Parent.lstSelected.Clear THISFORM.LockScreen = .F. ENDPROC Top = 102 Left = 186 Height = 25 Width = 37 FontBold = .T. FontName = "Courier New" FontSize = 11 Caption = "<<" TabIndex = 6 ToolTipText = "Alle Eintr schen." Name = "cmdRemoveAll" moverlists. cmdRemoveAll commandbutton commandbutton moverlists. cmdRemove% commandbutton "Arial, 0, 10, 6, 16, 13, 14, 3, 0 NDPROC * ELSE cbofontsize cmdExecuteQBF timer stopwatch datachecker combobox, 10, 6, 16, 13, 14, 3, 0 day, date, and time controly , cSecDisplay) This.lblMin Pixels GFontBold = .F. Height = 25 Style = 2 Width = 217 Name = "fontbox" cbofontname All text STATUS MODE stopped PARENT MCIALIAS DOMCI PLAYVIDEO Timer, AOBJECTREFS RELEASE OHOSTZ lookup_combo videoframe commandbuttonQ moverlists.xR{ checker.bmp checker.bmp manages conflicts Class gPROCEDURE Init DIMENSION x[1] =afont(x) FOR i = 1 TO ALEN(x) THIS.AddItem(x[i]) ENDFOR ENDPROC Image" nPos = STATUS MODE stopped PARENT MCIALIAS DOMCI PLAYSOUND Timer, container FTop = 96 Left = 120 Height = 23 Width = 23 Name = "tmrCheckMode" cmdAddAll comboboxvcx ADDITEM 1ombobox Classnts WITH THISFORM.Controls[m.i].pages[m. "Arial, 1, 10, 6, 16, 13, 15, 3, 0 clock Pixels !F:\VFP\SAMPLES\CONTROLS\clock.bmp !F:\VFP\SAMPLES\CONTROLS\clock.bmp THISFORM RELEASE Click, ~PROCEDURE Click *!* Clear the filter that was set SET FILTER TO GO TOP THIS.enabled = .F. THISFORM.Refresh ENDPROC PROCEDURE Timer cCmd = ("STATUS " + THIS.PARENT.MCIalias + " MODE") IF THIS.PARENT.doMCI(cCmd) = "stopped" THEN THIS.PARENT.playVideo ENDIF ENDPROC commandbutton commandbutton moverlists. Class RTop = 0 Left = 66 Height = 25 Width = 25 Interval = 1000 Name = "tmrSWatch" PARENT INCREMENT Timer, Pixelsting" 7displays the font sizes available for a particular font Classbox= "Editing" Height = 32 Left = 0 Top = 0 timer container MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 MS Sans Serif, 1, 8, 6, 13, 11, 12, 2, 0 MS Sans Serif, 2, 8, 5, 13, 11, 11, 2, 0 MS Sans Serif, 4, 8, 5, 13, 11, 11, 2, 0 tbrediting Pixels Class toolbar tbrediting tbrediting. ADDITEM Init, videoframe. tmrCheckMode timer cmdAdd commandbuttonH 1ontbox combobox Source.FontUnderline ENDCASE ENDPROC cbofontsize1 comboboxE Destroy This.Visible = .F. ENDPROC PROCED TIMEFORMAT DblClick, Hnappliesto 1 -- applies to current control -- applies to all controls Class control^ soundplayer DTop = 0 Left = 36 Height = 23 Width = 23 Name = "tmrCheckMode" timer control lookup_combo custom datachecker /Height = 15 Width = 23 Name = "datachecker" custom Pixelsting.gh all the controls on the page FOR m.k cbofontname Left = 125 ToolTipText = "FontName" Top = "Arial, 0, 10, 6, 16, 13, 14, 3, 0 CASE cTask = 'IN JArial, 0, 9, 5, 15, 12, 13, 3, 0 MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 Textbox Editbox print_report# _SCREEN.Activ Pixels VISIBL CProvides a form that allows users to choose the output of a report. Class Top = 71 Left = 186 Height = 25 Width = 37 FontBold = .T. FontName = "Courier New" FontSize = 11 Caption = "<" TabIndex = 5 ToolTipText = "Markierte Eintr schen." Name = "cmdRemove" stopwatch CASE CASE lcType $ "CM" lcValue = CHR(34) nhour ield, lcValue LOCAL lcType lcType = TPROCEDURE Click THISFORM.LockScreen = .T. nCnt = 1 DO WHILE nCnt <= THIS.Parent.lstSelected.ListCount IF THIS.Parent.lstSelected.Selected(nCnt) THIS.Parent.lstSource.AddItem(THIS.Parent.lstSelected.List(nCnt)) THIS.Parent.lstSelected.RemoveItem(nCnt) ELSE nCnt = nCnt + 1 ENDIF ENDDO THISFORM.LockScreen = .F. ENDPROC FontName = "MS Sans Serif" FontSize = 8 Height = 23 Width = 106 display_column = lookup_table = return_column = order_column = Name = "lookup_combo" rint must either be sp commandbutton Pixels Class PROCEDURE Click THISFORM.LockScreen = .T. FOR i = 1 to THIS.Parent.lstSource.ListCount THIS.Parent.lstSelected.AddItem(THIS.Parent.lstSource.List(i)) ENDFOR THIS.Parent.lstSource.Clear THISFORM.LockScreen = .F. ENDPROC Top = 33 Left = 186 Height = 25 Width = 37 FontBold = .T. FontName = "Courier New" FontSize = 11 Caption = ">>" TabIndex = 4 ToolTipText = "Alle Eintr ge hinzuf gen." Name = "cmdAddAll" PARENT QBF_TABLE ENABLED CMDEXECUTEQBF CMDCLEARFILTER THISFORM REFRESH Click, 1 PROCEDURE Click THISFORM.LockScreen = .T. * The ListCount value changes whenever the RemoveItem method is called nCnt = 1 DO WHILE nCnt <= THIS.Parent.lstSource.ListCount IF THIS.Parent.lstSource.Selected(nCnt) THIS.Parent.lstSelected.AddItem(THIS.Parent.lstSource.List(nCnt)) THIS.Parent.lstSource.RemoveItem(nCnt) ELSE nCnt = nCnt + 1 ENDIF ENDDO THISFORM.LockScreen = .F. ENDPROC Top = 2 Left = 186 Height = 25 Width = 37 FontBold = .T. FontName = "Courier New" FontSize = 11 Caption = ">" TabIndex = 3 ToolTipText = "Markierte Eintr ge hinzuf gen." Name = "cmdAdd" commandbutton moverlists.E lstSelected listbox listbox moverlists.ame specified or control source specified!") forme print_reports ,OLEObject = C:\WINDOWS\SYSTEM\COMDLG32.OCX GTop = 88 Left = 278 Height = 100 Width = 100 Name = "oleCommDlog" print_report. oleCommDlog olecontrols olecontrolw print_report. Width = 201 Height = 133 mcierror = 0 mcierrorstring = videofile = autoopen = .T. mcialias = autoplay = .T. autorepeat = .T. controlsource = Name = "videoframe" cmdClearFilter soundplayer.HD9H@ commandbutton tmrCheckMode lstSource THIS.videoFile IF EMPTY(cFileName) THEN listbox = THIS.controlSource IF EMPTY(cControlSource) T stopwatch. AutoSize = .F. Top = 71 Left = 4 Height = 23 Width = 72 FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Caption = "Filter \<l schen" Enabled = .F. TabIndex = 25 Name = "cmdClearFilter" Class Pixels cmdSaveAs commandbutton clock NTop = 3 Left = 8 Height = 12 Width = 14 Interval = 1000 Name = "Timer1" clock. *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. PixelsM.cmdExecute.Enabled = .T. ENDPROC PROCEDURE v watch.bmpSQL.Value = lcSQL THISFORM.cmdClear.Enabled watch.bmpSQL = "SELECT * FROM " + lcAlias + " " + lcWHER .stop watch with start, stop, and reset methodsbase table Class1 + " " + lcRelation1 + " "; + lcValue1 + " " + 7 the first part of the WHERE condition lcWHERE = "WHER container + ; lcRelation2 + " " + lcValue2 ENDIF stopwatchd2.Value,lcValue2) lcWHERE = lcOperand + " " AutoSize = .T. FontBold = .T. FontName = "Arial" FontSize = 13 BackStyle = 0 Caption = "00" Height = 22 Left = 68 Top = 5 Width = 20 Name = "lblSeconds" = THISFORM.Validate stopwatch.put the proper delimiters around comparison va lblSeconds label COMMENT RESERVED label( AutoSize = .T. FontBold = .T. FontName = "Arial" FontSize = 13 BackStyle = 0 Caption = "00" Height = 22 Left = 37 Top = 5 Width = 20 Name = "lblMinutes" _RAA0N09Z2 54796852 stopwatch. _RAA0MM0SN 547968029 lblMinutes listboxideo *!* Get needed properties into variables RTop = 0 Left = 66 Height = 25 Width = 25 Interval = 1000 Name = "tmrSWatch" tmrSWatch label WINDOWS _RAA0MM0S8 547968029 label AutoSize = .T. FontBold = .T. FontName = "Arial" FontSize = 13 BackStyle = 0 Caption = "00" Height = 22 Left = 6 Top = 5 Width = 20 Name = "lblhours" WINDOWS _R9818X stopwatch. WINDOWS _R9818X1QY 547968029- lblhours label WINDOWS _QU00R9JY0 547 labelVU 547968029 FontBold = .T. FontName = "Arial" FontSize = 13 Alignment = 0 BackStyle = 0 Caption = ":" Height = 19 Left = 58 Top = 4 Width = 11 Name = "lblSeparator2" stopwatch. WINDOWS _QU00R9JSB 547968526 lblSeparator2 container container PROCEDURE Timer THIS.Parent.nSec = THIS.Parent.nSec + 1 IF THIS.Parent.nSec = 60 THIS.Parent.nSec = 0 THIS.Parent.nMin = THIS.Parent.nMin + 1 ENDIF IF THIS.Parent.nMin = 60 THIS.Parent.nMin = 0 THIS.Parent.nHour = THIS.Parent.nHour + 1 ENDIF THIS.Parent.UpdateDisplay THIS.Parent.ElapsedSeconds = (THIS.Parent.nHour * 3600) + ; (THIS.Parent.nMin * 60) + ; (This.Parent.nSec) ENDPROC tmrSWatch samples.vcx cbofontsize DHeight = 25 Left = 4 Top = 4 Width = 157 Name = "Cbofontname1" rtfcontrols. Cbofontname1M combobox PROCEDURE Timer #DEFINE LONGDATE_LOC CDOW(DATE())+" "+CMONTH(DATE())+" "+ALLTRIM(STR(DAY(DATE())))+", "+ALLTRIM(STR(YEAR(DATE()))) IF This.Parent.TimeFormat = 0 This.Parent.txtTime.Value = IIF(VAL(SUBSTR(TIME(),1,2))>12, ; ALLTRIM(STR((VAL(SUBSTR(TIME(),1,2))-12)))+SUBSTR(TIME(),3,6),TIME()) This.Parent.txtTime.Value = TIME() ENDIF THIS.Parent.txtDate.Value = LONGDATE_LOC ENDPROC Timer1 timer timer .FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 ColumnCount = 0 ColumnWidths = "" RowSourceType = 0 RowSource = "" ControlSource = "" DragIcon = grid\ DragMode = 0 Height = 132 Left = 0 MultiSelect = .T. NumberOfElements = 0 TabIndex = 1 Top = 0 Width = 169 Name = "lstSource" ATUS " + c timer TAlignment = 2 BackStyle = 0 BorderStyle = 0 Value = (IIF(THIS.PARENT.TimeFormat = 0, IIF(VAL(SUBSTR(time(),1,2))>12, ALLT(STR((VAL(SUBSTR(time(),1,2))-12)))+SUBSTR(time(),3,6), time()),time())) Enabled = .F. Height = 21 Left = 184 Top = 5 Width = 57 DisabledForeColor = 0,0,0 DisabledBackColor = 255,255,255 Name = "txtTime" clock. txtTime textbox textbox clock. stopwatch. 5Alignment = 2 BackColor = 255,255,0 BackStyle = 0 BorderStyle = 0 Value = (CDOW(date())+" "+CMONTH(date())+" "+ ALLT(STR(DAY(date())))+", "+ALLT(STR(YEAR(date())))) Enabled = .F. Height = 21 Left = 3 Top = 5 Width = 179 DisabledForeColor = 0,0,0 DisabledBackColor = 255,255,255 Name = "txtDate" txtDate textbox textbox timeformat label WINDOWS _R labelENT Screen stopwatch. lblSeparator1 KPROCEDURE DblClick THIS.TimeFormat = ABS(THIS.TimeFormat - 1) ENDPROC ZWidth = 251 Height = 28 BackStyle = 0 BorderWidth = 0 timeformat = 0 Name = "clock" container PROCEDURE Click * Display file dialog thisform.oleCommDlog.ShowSave() IF thisform.oleCommDlog.FileName <> "*.*" THISFORM.txtFileName.Value = thisform.oleCommDlog.FileName THISFORM.txtFileName.SetFocus ENDIF ENDPROC Top = 83 Left = 228 Height = 19 Width = 19 FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Caption = "..." Enabled = .F. Name = "cmdSaveAs" commandbutton ,PROCEDURE Click THISFORM.Release ENDPROC SHOWSA print_report. Width = 409 Height = 132 BackStyle = 0 BorderWidth = 0 mousex = 0 mousey = 0 candropicon = DRAGMOVE.CUR nodropicon = NODROP01.CUR dragthreshold = 8 Name = "moverlists" container cmdCancelFORM.txtFileName.SetFocus ENDIF ENDPROC container container stopwatch `Width = 94 Height = 25 nsec = 0 nmin = 0 nhour = 0 elapsedseconds = 0 Name = "stopwatch" PROCEDURE start This.tmrSWatch.enabled = .t. ENDPROC PROCEDURE stop This.tmrSWatch.enabled = .f. ENDPROC PROCEDURE Reset This.nSec = 0 This.nMin = 0 This.nHour = 0 This.UpdateDisplay ENDPROC PROCEDURE updatedisplay cSecDisplay = ALLTRIM(STR(This.nSec)) cMinDisplay = ALLTRIM(STR(This.nMin)) cHourDisplay = ALLTRIM(STR(This.nHour)) This.lblSeconds.Caption = IIF(This.nSec < 10, "0" + cSecDisplay , cSecDisplay) This.lblMinutes.Caption = IIF(This.nMin < 10, "0" + cMinDisplay , cMinDisplay) This.lblHours.Caption = IIF(This.nHour < 10, "0" + cHourDisplay , cHourDisplay) ENDPROC PROCEDURE Init nMin = 0 nSec = 0 nHour = 0 ENDPROC timer nhour elapsedseconds The time displayed in the stopwatch in elapsed seconds. *start *stop *Reset ,Property Description will appear here. *updatedisplay `Width = 94 Height = 25 nsec = 0 nmin = 0 nhour = 0 elapsedseconds = 0 Name = "stopwatch" PROCEDURE selectall LPARAMETERS oList LOCAL lnCnt FOR lnCnt = 1 to oList.ListCount oList.Selected(lnCnt) = .T. ENDFOR ENDPROC PROCEDURE Init This.lstSource.DragIcon = This.CanDropIcon This.lstSelected.DragIcon = This.CanDropIcon ENDPROC is returned. cRetString = space(80) nRetValue = mciSendStr commandbuttonORM.txtFileName.Value = thisform.oleCommDlo nhour elapsedseconds The time displayed in the stopwatch in elapsed seconds. *start *stop *Reset ,Property Description will appear here. *updatedisplay nsmallestfont for scalable fonts, smallest allowable fontsize nlargestfont for scalable fonts, specifies the largest allowable fontsize *filllist FontBold = .F. Height = 25 Style = 2 ToolTipText = "Schriftgrad" Width = 44 nsmallestfont = 6 nlargestfont = 24 Name = "cbofontsize" .ControlCount IF oForm.Controls(i).Base commandbutton.ShowSave() IF thisform.oleCommDlog.File PROCEDURE Timer THIS.Parent.nSec = THIS.Parent.nSec + 1 IF THIS.Parent.nSec = 60 THIS.Parent.nSec = 0 THIS.Parent.nMin = THIS.Parent.nMin + 1 ENDIF IF THIS.Parent.nMin = 60 THIS.Parent.nMin = 0 THIS.Parent.nHour = THIS.Parent.nHour + 1 ENDIF THIS.Parent.UpdateDisplay THIS.Parent.ElapsedSeconds = (THIS.Parent.nHour * 3600) + ; (THIS.Parent.nMin * 60) + ; (This.Parent.nSec) ENDPROC PROCEDURE start This.tmrSWatch.enabled = .t. ENDPROC PROCEDURE stop This.tmrSWatch.enabled = .f. ENDPROC PROCEDURE Reset This.nSec = 0 This.nMin = 0 This.nHour = 0 This.UpdateDisplay ENDPROC PROCEDURE updatedisplay cSecDisplay = ALLTRIM(STR(This.nSec)) cMinDisplay = ALLTRIM(STR(This.nMin)) cHourDisplay = ALLTRIM(STR(This.nHour)) This.lblSeconds.Caption = IIF(This.nSec < 10, "0" + cSecDisplay , cSecDisplay) This.lblMinutes.Caption = IIF(This.nMin < 10, "0" + cMinDisplay , cMinDisplay) This.lblHours.Caption = IIF(This.nHour < 10, "0" + cHourDisplay , cHourDisplay) ENDPROC PROCEDURE Init nMin = 0 nSec = 0 nHour = 0 ENDPROC PROCEDURE Click *!* In order to clear out all the controls with a controlSource, *!* we need to start a transaction and append a record (then when *!* we are done we'll rollback the transaction so the new record *!* doesn't get added to the table IF !EMPTY(THIS.Parent.QBF_table) THEN SELECT (THIS.Parent.QBF_table) ENDIF BEGIN TRANSACTION APPEND BLANK THIS.Enabled = .F. THIS.Parent.cmdExecuteQBF.Enabled = .T. THIS.Parent.cmdClearFilter.enabled = .F. THISFORM.Refresh ENDPROC commandbutton timer samples.vcx cbofontname *.txt Text (*.txt)|*.t\ 28C4C820-401A-101B-A3C9-08002B2F49FB FileName *.txt Filter Text xt (*.txt)|*.txt )MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 1 combobox PROCEDURE filllist LPARAMETERS cFontName THIS.Clear DIMENSION aSizes[1] =AFONT(aSizes, cFontname) IF aSizes[1] = -1 && The font is scalable lScalable = .T. nLen = THIS.nLargestFont nStart = THIS.nSmallestFont nLen = ALEN(aSizes) nStart = 1 lScalable = .F. ENDIF IF lScalable FOR i = nStart TO nLen THIS.AddItem(ALLTRIM(STR(i))) ENDFOR FOR i = nStart TO nLen THIS.AddItem(ALLTRIM(STR(aSizes[i]))) ENDFOR ENDIF ENDPROC THIS.chkBold.Value = oS Top = 42 Left = 261 Height = 23 Width = 72 FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Cancel = .T. Caption = "Abbrechen" Name = "cmdCancel" Top = 14 Left = 261 Height = 23 Width = 72 FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Caption = "OK" Default = .T. Name = "cmdOK" PGREPORTOUTPUT VALUE RELEASE FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Value = 0 Height = 22 Left = 265 Style = 2 ToolTipText = "Vordergrund-/Hintergrundfarbe" Top = 5 Width = 69 Name = "cboColor" cboColor combobox combobox BTop = 5 Left = 265 Height = 22 Width = 0 Name = "Separator2" tbrediting. Separator2 separator separator _SCREEN.ActiveFormb FontUnderline TEXTBOX FontUnderline EDITBOX FontUnderline OFORM ACTIVEFORM PARENT NAPPLIESTO ACTIVECONTROL FONTUNDERLINE VALUE SETALL InteractiveChange, tbrediting. THISFORM OLECOMMDLOG SHOWSAVE FILENAME TXTFILENAME VALUE SETFOCUS Click, )MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 print_report. cmdOK commandbuttone specified in the cReport property of this commandbutton AutoSize = .T. FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 BackStyle = 0 Caption = "Dateiname:" Height = 15 Left = 37 Top = 85 Width = 52 Name = "Label2" AutoSize = .T. FontBold = .T. FontName = "Arial" FontSize = 13 BackStyle = 0 Caption = ":" Height = 22 Left = 26 Top = 4 Width = 8 Name = "lblSeparator1" PROCEDURE InteractiveChange IF TYPE("_SCREEN.ActiveForm") = 'O' oForm = _SCREEN.ActiveForm RETURN ENDIF DO CASE CASE THIS.Parent.nAppliesTo = 1 && Current Control oForm.ActiveControl.FontUnderline = THIS.Value CASE THIS.Parent.nAppliesTo = 2 && All textboxes and editboxes oForm.SetAll('FontUnderline', THIS.Value, 'TEXTBOX') oForm.SetAll('FontUnderline', THIS.Value, 'EDITBOX') CASE THIS.Parent.nAppliesTo = 3 && All Controls oForm.SetAll('FontUnderline', THIS.Value) ENDCASE ENDPROC Top = 5 Left = 234 Height = 22 Width = 26 FontName = "MS Sans Serif" FontSize = 8 FontUnderline = .T. Caption = "U" Value = .F. Style = 1 ToolTipText = "Unterstrichen" Name = "chkUnderline" chkUnderline checkbox checkbox Top = 5 Left = 209 Height = 22 Width = 26 FontItalic = .T. FontName = "MS Sans Serif" FontSize = 8 Caption = "K" Value = .F. Style = 1 ToolTipText = "Kursiv" Name = "chkItalic" distinct_values_combo \PROCEDURE Click #DEFINE NO_REPORT_LOC "Der zu druckende Bericht mu in der cReport-Eigenschaft des Formulars angegeben sein oder als Parameter bergeben werden." #DEFINE NO_FILENAME_LOC "Sie m ssen einen Dateinamen eingeben." DO CASE CASE EMPTY(THISFORM.cReport) =MESSAGEBOX(NO_REPORT_LOC) CASE THISFORM.opgReportOutput.value = 1 THISFORM.Release REPORT FORM (THISFORM.cReport) PREVIEW NOCONSOLE CASE THISFORM.opgReportOutput.value = 2 THISFORM.Release REPORT FORM (THISFORM.cReport) TO PRINTER NOCONSOLE CASE THISFORM.opgReportOutput.value = 3 IF EMPTY(THISFORM.txtFileName.value) THEN =MESSAGEBOX(NO_FILENAME_LOC) THISFORM.txtFileName.SetFocus ELSE THISFORM.Release REPORT FORM (THISFORM.cReport) ; TO FILE (THISFORM.txtFileName.value) ; ASCII NOCONSOLE ENDIF ENDCASE ENDPROC print_report.elease REPORT FORM (THISFORM.cReport) ; Label2_FILENAME_LOC) THISFORM.txtFileName.SetFocus label3 IF EMPTY(THISFORM.txtFileName.value) THEN labelO PRINTER NOCONSOLE CASE THISFORM.opgReportOu timer control& 0Width = 311 Height = 32 Name = "rtfcontrols" FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Enabled = .F. Height = 23 Left = 95 Top = 81 Width = 128 Name = "txtFileName" THISFORM.Release REPORT FORM (THISFO print_report. =MESSAGEBOX(NO_REPORT_LOC) CASE THI txtFileNamet enter a file name." DO CASE CASE EMPTY tbrediting. chkItalic label RESERVED7 label RESERVED5 1PROCEDURE Timer THIS.Parent.Increment ENDPROC RTop = 2 Left = 52 Height = 25 Width = 25 Interval = 1000 Name = "tmrSWatch" OBJNAME _SCREEN.ActiveFormb oControl.ForeColorb oControl.ItemForeColorb ForeColor TEXTBOX ForeColor EDITBOX ForeColor oForm.ActiveControl.BackColorb oForm.ActiveControl.ItemBackColorb BackColor TEXTBOX BackColor EDITBOX BackColor OFORM ACTIVEFORM OCONTROL ACTIVECONTROL VALUE NFORECOLOR THISFORM NAPPLIESTO FORECOLOR ITEMFORECOLOR SETALL NBACKCOLOR BACKCOLOR ITEMBACKCOLOR Farben Vordergrundfarbe festlegen... Hintergrundfarbe festlegen... ADDITEM LISTINDEX InteractiveChange, Init^ _SCREEN.ActiveFormb FontItalic TEXTBOX FontItalic EDITBOX FontItalic OFORM ACTIVEFORM PARENT NAPPLIESTO ACTIVECONTROL FONTITALIC VALUE SETALL InteractiveChange, _SCREEN.ActiveFormb FontBold TEXTBOX FontBold EDITBOX FontBold OFORM ACTIVEFORM PARENT NAPPLIESTO ACTIVECONTROL FONTBOLD VALUE SETALL InteractiveChange, _SCREEN.ActiveFormb FontSizeC TEXTBOX FontSizeC EDITBOX FontSizeC OFORM ACTIVEFORM PARENT NAPPLIESTO ACTIVECONTROL FONTSIZE VALUE SETALL Das Steuerelement unterst tzt den ausgew hlten Schriftgrad nicht. Application.ActiveForm.ActiveControlb Fehlernummer: CC Fehlermeldung: Prozedur: NERROR CMETHOD NLINE PARENT REFRESH APPLICATION ACTIVEFORM ACTIVECONTROL LCMSG LNANSWER InteractiveChange, Error )MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 THISFOR Class textboxhe cReport property of this form." #DEFINE NO_FI textboxRE Click #DEFINE NO_REPORT_LOC "A report must be AutoSize = .T. FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 BackStyle = 1 Caption = " Berichtausgabe " Height = 15 Left = 20 Top = 7 Width = 75 Name = "lblReportOutput" lt = .T. Name = "cmdOK" print_report. lblReportOutput labelndbutton label37 Top = 85 Width = 52 Name = "Label2" checkbox stopwatch. TIMESTAMP tmrSWatch PLATFORM timer timer nhour elapsedseconds The time displayed in the stopwatch in elapsed seconds. *start *stop *reset ,Property Description will appear here. *updatedisplay *increment increment the stopwatch display containerF thHtY "Arial, 1, 10, 6, 16, 13, 14, 3, 0 frmnotitle Pixels Class frmnotitle Top = 0 Left = 0 Height = 150 Width = 300 DoCreate = .T. BorderStyle = 1 Caption = "" Closable = .F. ControlBox = .F. MaxButton = .F. MinButton = .F. Movable = .F. AlwaysOnTop = .T. ZoomBox = .F. Name = "frmnotitle" resizable minitialresize initialformheight initialformwidth addtoarray setsize loopthroughcontrols acontrolstats Pixels Class custom resizable $initialresize Is this the first time the controls are being adjusted? initialformheight initialformwidth *adjustcontrols call from resize event of a form to adjust the placement and size of contained objects. *addtoarray *setsize *loopthroughcontrols *reset ^acontrolstats[1,5] oHeight = 19 Width = 27 initialresize = .T. initialformheight = 0 initialformwidth = 0 Name = "resizable" custom THISFORM TXTFILENAME ENABLED CMDSAVEAS% THISFORM TXTFILENAME ENABLED CMDSAVEAS% THISFORM TXTFILENAME ENABLED CMDSAVEAS optPreview.Click, optPrinter.Click optFile.Click commandbutton PROCEDURE InteractiveChange IF TYPE("_SCREEN.ActiveForm") = 'O' oForm = _SCREEN.ActiveForm RETURN ENDIF DO CASE CASE THIS.Parent.nAppliesTo = 1 && Current Control oForm.ActiveControl.FontItalic = THIS.Value CASE THIS.Parent.nAppliesTo = 2 && All textboxes and editboxes oForm.SetAll('FontItalic', THIS.Value, 'TEXTBOX') oForm.SetAll('FontItalic', THIS.Value, 'EDITBOX') CASE THIS.Parent.nAppliesTo = 3 && All Controls oForm.SetAll('FontItalic', THIS.Value) ENDCASE ENDPROC dFontName = "MS Sans Serif" FontSize = 8 Height = 23 Width = 106 Name = "distinct_values_combo" File Name:" Height PROCEDURE Timer cCmd = ("STATUS " + THIS.PARENT.MCIalias + " MODE") IF THIS.PARENT.doMCI(cCmd) = "stopped" THEN THIS.PARENT.playSound ENDIF ENDPROC checkbox tbrediting. UFontBold = .F. FontName = "MS Sans Serif" FontSize = 8 ColumnCount = 0 ColumnWidths = "" RowSourceType = 0 RowSource = "" ControlSource = "" DragIcon = grid\ DragMode = 0 FirstElement = 1 Height = 132 Left = 240 MoverBars = .T. MultiSelect = .T. NumberOfElements = 0 TabIndex = 2 Top = 0 Width = 169 Name = "lstSelected" rtfcontrols. container |Top = 4 Left = 283 Height = 23 Width = 25 Caption = "A" ToolTipText = "Farbe" ForeColor = 255,0,0 Name = "cmdColor" rtfcontrols _SCREEN.ActiveFormb _SCREEN.ActiveForm.ActiveControlb FontName TEXTBOX FontName EDITBOX FontName OFORM OCONTROL ACTIVEFORM ACTIVECONTROL PARENT NAPPLIESTO FONTNAME VALUE SETALL CBOSIZES FILLLIST REFRESH InteractiveChange, _SCREEN.ActiveFormb Textbox Editbox oSourceb OSOURCE NAPPLIESTO OFORM ACTIVEFORM CONTROLCOUNT CONTROLS BASECLASS CBOFONTS VALUE FONTNAME CBOSIZES FILLLIST FONTSIZE CHKBOLD FONTBOLD CHKITALIC FONTITALIC CHKUNDERLINE FONTUNDERLINE VISIBLE Refresh, Destroy. Height = 136 Width = 342 Desktop = .T. DoCreate = .T. AutoCenter = .T. BorderStyle = 2 Caption = "Bericht drucken" MaxButton = .F. MinButton = .F. WindowType = 1 creport = Name = "print_report" Mismatched pushjmp/popjmp call. Curso formlsd in, the variables are automatically *!* set to 7creport Specifies the report to print from this form. PROCEDURE InteractiveChange IF TYPE("_SCREEN.ActiveForm") = 'O' oForm = _SCREEN.ActiveForm RETURN ENDIF DO CASE CASE THIS.Parent.nAppliesTo = 1 && Current Control oForm.ActiveControl.FontBold = THIS.Value CASE THIS.Parent.nAppliesTo = 2 && All textboxes and editboxes oForm.SetAll('FontBold', THIS.Value, 'TEXTBOX') oForm.SetAll('FontBold', THIS.Value, 'EDITBOX') CASE THIS.Parent.nAppliesTo = 3 && All Controls oForm.SetAll('FontBold', THIS.Value) ENDCASE ENDPROC chkBold checkbox comboboxILENAME_LOC) THISFORM.txtFileName.SetFocus >PROCEDURE optPreview.Click THISFORM.txtFileName.enabled = .F. THISFORM.cmdSaveAs.enabled = .F. ENDPROC PROCEDURE optPrinter.Click THISFORM.txtFileName.enabled = .F. THISFORM.cmdSaveAs.enabled = .F. ENDPROC PROCEDURE optFile.Click THISFORM.txtFileName.enabled = .T. THISFORM.cmdSaveAs.enabled = .T. ENDPROC erver. Error saving the OLE object. Error creating the OLE mcierror Specifies the result of the last MCI command executed. mcierrorstring Stores the error string from the last MCI command executed. videofile Specifies the video file associated with the Video Frame. autoopen Specifies whether the video file specified should be automatically opened when the class is created. mcialias Specifies the alias for the video file when calling MCI commands. If empty, the name of the file is used. autoplay Specifies whether the video file should automatically play after opening. autorepeat If .T., video will continuously play controlsource Specifies the source of data to which an object is bound. *domci Executes a MCI command. *getmcierror Stores the last MCI error into properties of the class. *openvideo Opens the video file and shows it. *playvideo Plays the currently loaded video. *pausevideo Pauses a currently playing video. *showmcierror Displays the result of the last MCI command in a messagebox. *closevideo Closes the video file and releases all resources. *setposition Allows the user to set the position of the media file; Valid values are Start, End, or a number representing milliseconds. PROCEDURE parsecondition LPARAMETERS cCondition, cControlSource LOCAL lcRetCondition, lcFieldName IF TYPE('cCondition') = 'C' cCondition = ALLTRIM(cCondition) ENDIF lcFieldName = SUBSTRC(cControlSource,(RATC(".",cControlSource)+1)) *!* NOTE: If you add a checkbox, radio button, or command group to *!* the form, this routine will need to be changed to handle that *!* specific datatype. IF !EMPTY(cCondition) THEN *!* If the type is Character or Memo, check to see if the *!* user has entered a complex condition (if so, take that *!* condition literally without any manipulation IF TYPE('cCondition')$ "CM" IF ("<" $ cCondition OR ; "==" $ cCondition OR ; "LIKE" $ cCondition OR ; "<>" $ cCondition OR ; "!=" $ cCondition OR ; "#" $ cCondition OR ; "=" $ cCondition OR ; ">" $ cCondition) lcRetCondition = lcFieldName + cCondition ENDIF ENDIF *!* If a complex condition wasn't found above (lcRetCondition will be empty) *!* Then we need to create the WHERE condition ourselves IF EMPTY(lcRetCondition) *!* The RATC() Functions figure out the column to compare based on the *!* controlSource of the control and any delimiters needed for the *!* datatype are added around the values (not all conditions are *!* assumed to be = when we construct them ourselves DO CASE CASE TYPE(cControlSource) $ "CM" lcRetCondition = lcFieldName + " = " + CHR(34) + cCondition + CHR(34) CASE TYPE(cControlSource) $ "DT" lcRetCondition = lcFieldName + " = {" + DTOC(cCondition) + "}" OTHERWISE lcRetCondition = lcFieldName + " = " + STR(cCondition) ENDCASE ENDIF lcRetCondition = "" ENDIF RETURN lcRetCondition ENDPROC 8PROCEDURE InteractiveChange LOCAL oForm, oControl IF TYPE("_SCREEN.ActiveForm") = "O" AND TYPE("_SCREEN.ActiveForm.ActiveControl") = "O" oForm = _SCREEN.ActiveForm oControl = oForm.ActiveControl RETURN ENDIF DO CASE CASE THIS.Parent.nAppliesTo = 1 && Current Control oControl.FontName = This.Value CASE THIS.Parent.nAppliesTo = 2 && All textboxes and editboxes oForm.SetAll('FontName', This.Value, 'TEXTBOX') oForm.SetAll('FontName', This.Value, 'EDITBOX') *================================================================== * comment out the previous 2 lines and uncomment the following lines * if you want to affect all controls with a baseclass of textbox * or editbox. *------------------------------------------------------------------ *FOR i = 1 to oForm.ControlCount * <find out what the baseclass property is to avoid having to UPPER> * IF UPPER(oForm.Controls(i).BaseClass) = 'TEXTBOX' OR ; * UPPER(oForm.Controls(i).BaseClass) = 'EDITBOX' * oForm.Controls(i).FontName = THIS.Value * ENDIF *ENDFOR *================================================================== CASE THIS.Parent.nAppliesTo = 3 && All Controls oForm.SetAll('FontName', This.Value) ENDCASE THIS.Parent.cboSizes.FillList(THIS.Value) THIS.Parent.Refresh(oControl) ENDPROC THISFORM.Controls(nCnt).controlSourceb THISFORM.Controls(nCnt).valueb AND SET FILTER TO &cFilter CFILTER THISFORM CONTROLCOUNT CONTROLS CONTROLSOURCE CCONDITION PARENT PARSECONDITION VALUE ENABLED CMDQBFMODE CMDCLEARFILTER REFRESH Click, cConditionb cConditionb CCONDITION CCONTROLSOURCE LCRETCONDITION LCFIELDNAME parsecondition, USE IN &cCursor CCURSOR NAME_ Der Tabellenalias mu in der ControlSource-Eigenschaft im Format 'alias.column' angegeben werden. SELECT DISTINCT FROM INTO CURSOR c CONTROLSOURCE CALIAS CCOLUMN ROWSOURCETYPE NAME ROWSOURCE Destroy, Der zu druckende Bericht mu in der cReport-Eigenschaft des Formulars angegeben sein oder als Parameter bergeben werden. Sie m ssen einen Dateinamen eingeben. THISFORM CREPORT OPGREPORTOUTPUT VALUE RELEASE TXTFILENAME SETFOCUS Click, THISFORM LOCKSCREEN PARENT LSTSELECTED LISTCOUNT LSTSOURCE ADDITEM CLEAR Click, cbofontname commandbutton AutoSize = .F. Top = 3 Left = 4 Height = 23 Width = 72 FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Caption = "QBF \<eingeben" TabIndex = 23 Name = "cmdQBFMode" Width = 92 Height = 27 BackStyle = 0 BorderWidth = 0 nsec = 0 nmin = 0 nhour = 0 elapsedseconds = 0 Name = "stopwatch" checkbox nArial, 0, 9, 5, 15, 12, 13, 3, 0 Courier New, 1, 9, 7, 16, 12, 8, 4, 0 Courier New, 3, 9, 7, 16, 12, 10, 4, 0 Width = 33 Height = 36 BorderWidth = 0 mcierror = 0 mcierrorstring = autoopen = .T. mcialias = autoplay = .T. autorepeat = .T. controlsource = Name = "soundplayer" Top = 5 Left = 184 Height = 22 Width = 26 FontBold = .T. FontName = "MS Sans Serif" FontSize = 8 Caption = "F" Value = .F. Style = 1 ToolTipText = "Fett" Name = "chkBold" BTop = 5 Left = 184 Height = 22 Width = 0 Name = "Separator1" tbrediting. Separator1 separator THISFORM LOCKSCREEN PARENT LSTSOURCE LISTCOUNT LSTSELECTED ADDITEM CLEAR Click, print_report.ommands are in effect. Compiled code for th opgReportOutputey. Too many READ commands are in effect. Pixels separator _FontName = "MS Sans Serif" FontSize = 8 Height = 22 Left = 135 Top = 5 Name = "cboSizes" tbrediting. rtfcontrols containerP3 Class Pixels7 PROCEDURE adjustcontrols IF THIS.InitialResize THIS.LoopThroughControls("INITIALIZE_AND_ADJUST") THIS.InitialResize = .F. 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.Top = THISFORM.Height * THIS.aControlStats[nPos,1] oControl.Left = THISFORM.Width * THIS.aControlStats[nPos,2] oControl.Width = THISFORM.Width * THIS.aControlStats[nPos,4] IF !oControl.Baseclass $ "Textbox Spinner" oControl.Height = THISFORM.Height * THIS.aControlStats[nPos,3] ENDIF *IF oControl.Baseclass = "Commandbutton" * IF TXTWIDTH(oControl.caption) > oControl.width * oControl.FontSize = 8 * ELSE * oControl.FontSize = 10 * ENDIF *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 4 #define BASE_CLASS "Commandbutton Combobox Checkbox Listbox Form Grid Textbox Label Shape Editbox Olecontrol Pageframe Image Spinner" nPos = 0 THISFORM.LockScreen = .T. FOR m.i = 1 TO THISFORM.ControlCount oControl = THISFORM.Controls[m.i] IF oControl.Baseclass$BASE_CLASS nPos = nPos + 1 DO CASE CASE cTask = 'INITIALIZE_AND_ADJUST' THIS.AddToArray(oControl) THIS.SetSize(oControl, nPos) CASE cTask = 'ADJUST' THIS.SetSize(oControl, nPos) ENDCASE 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 IF .Controls[m.k].Baseclass$BASE_CLASS nPos = nPos + 1 DO CASE CASE cTask = 'INITIALIZE_AND_ADJUST' THIS.AddToArray(.Controls[m.k]) THIS.SetSize(.Controls[m.k], nPos) CASE cTask = 'ADJUST' THIS.SetSize(.Controls[m.k], nPos) ENDCASE ENDIF ENDFOR ENDWITH ENDFOR ENDIF ENDFOR THISFORM.LockScreen = .F. SET DECIMAL TO nOldDecimal ENDPROC PROCEDURE Init THIS.InitialFormHeight = THISFORM.Height THIS.InitialFormWidth = THISFORM.Width ENDPROC PROCEDURE reset THIS.InitialResize = .T. DIMENSION THIS.aControlStats[1,5] ENDPROC mcierror Specifies the result of the last MCI command executed. mcierrorstring Stores the error string from the last MCI command executed. autoopen Specifies whether the video file specified should be automatically opened when the class is created. mcialias Specifies the alias for the video file when calling MCI commands. If empty, the name of the file is used. autoplay Specifies whether the video file should automatically play after opening. autorepeat If .T., video will continuously play soundfile Specifies the sound file associated with the Sound Player. controlsource Specifies the source of data to which an object is bound. *domci Executes a MCI command. *getmcierror Stores the last MCI error into properties of the class. *showmcierror Displays the result of the last MCI command in a messagebox. *setposition Allows the user to set the position of the media file; Valid values are Start, End, or a number representing milliseconds. *opensound Opens the sound file. *pausesound Pauses the currently playing sound. *playsound Plays the loaded sound file. *closesound Closes the loaded sound file and releases it's resources. cboSizes combobox samples.vcx gmousex stores x coordinate of mouse pointer position mousey stores y coordinate of mouse pointer position candropicon Cursor when dropping is okay nodropicon dragthreshold number of pixels a user has to move the mouse with the left mouse button down for the drag method to be called. *selectall selects all items in the listbox passed in as a parameter ENDPROC cRepNameb Der zu druckende Bericht mu in der cReport-Eigenschaft des Formulars angegeben sein oder als Parameter bergeben werden. Die Berichtdatei ' ' existiert nicht. Sie m ssen eine g ltige Berichtdatei angeben, die in der cReport-Eigenschaft des Formulars gedruckt oder als Parameter bergeben wird. CREPNAME THISFORM CREPORT Init, THISFORM LOCKSCREEN PARENT LSTSELECTED LISTCOUNT SELECTED LSTSOURCE ADDITEM REMOVEITEM Click, combobox comboboxE Init #DEFINE REPORT_NOT_FOUND_LOC "The report optiongroupion file. Total label width exceeds allowed s optiongroupny characters in the report. Invalid expressi commandbutton PROCEDURE InteractiveChange IF TYPE("_SCREEN.ActiveForm") = 'O' oForm = _SCREEN.ActiveForm oControl = oForm.ActiveControl RETURN ENDIF DO CASE CASE This.Value = 1 RETURN CASE This.Value = 2 && Get ForeColor nForeColor = GETCOLOR() IF nForeColor > -1 DO CASE CASE THISFORM.nAppliesTo = 1 && current control IF TYPE("oControl.ForeColor") = "N" oControl.ForeColor = nForeColor ELSE IF TYPE("oControl.ItemForeColor") = "N" oControl.ItemForeColor = nForeColor ENDIF ENDIF CASE THISFORM.nAppliesTo = 2 && text and edit boxes oForm.SetAll('ForeColor', nForeColor, 'TEXTBOX') oForm.SetAll('ForeColor', nForeColor, 'EDITBOX') CASE THISFORM.nAppliesTo = 3 && All controls oForm.SetAll('ForeColor', nForeColor) ENDCASE ENDIF CASE This.Value = 3 && Get BackColor nBackColor = GETCOLOR() IF nBackColor > -1 DO CASE CASE THISFORM.nAppliesTo = 1 && current control IF TYPE("oForm.ActiveControl.BackColor") = "N" oForm.ActiveControl.BackColor = nBackColor ELSE IF TYPE("oForm.ActiveControl.ItemBackColor") = "N" oForm.ActiveControl.ItemBackColor = nBackColor ENDIF ENDIF CASE THISFORM.nAppliesTo = 2 && text and edit boxes oForm.SetAll('BackColor', nBackColor, 'TEXTBOX') oForm.SetAll('BackColor', nBackColor, 'EDITBOX') CASE THISFORM.nAppliesTo = 3 && All controls oForm.SetAll('BackColor', nBackColor) ENDCASE ENDIF ENDCASE THIS.Value = 1 ENDPROC PROCEDURE Init THIS.AddItem("Farben") THIS.AddItem("Vordergrundfarbe festlegen...") THIS.AddItem("Hintergrundfarbe festlegen...") THIS.ListIndex = 1 ENDPROC cbofontsize tbrediting. In der'lookup_table'-Eigenschaft (Kombinationsfeld eine Suchtabelle angegeben werden. In der 'display_column'-Eigenschaft (Kombinationsfeld eine Anzeigespalte angegeben werden. In der 'return_column'-Eigenschaft (Kombinationsfeld eine R ckgabespalte angegeben werden. SELECT FROM ORDER BY INTO CURSOR SELECT FROM INTO CURSOR LOOKUP_TABLE DISPLAY_COLUMN RETURN_COLUMN ORDER_COLUMN ROWSOURCETYPE ROWSOURCE BOUNDCOLUMN REFRESH In der 'display_column'- oder 'return_column'-Eigenschaft (Kombinationsfeld ) wurde eine ung ltige Anzeige- oder R ckgabespalte angegeben. In der 'order_column'-Eigenschaft (Kombinationsfeld ) wurde eine ung ltige Spalte angegeben. In der 'display_column'- oder 'lookup_table'-Eigenschaft (Kombinationsfeld ) wurde eine ung ltige Tabelle angegeben. NERROR CMETHOD NLINE NAME8 USE IN &cAlias CALIAS Init, Error Destroy THISFORM LOCKSCREEN PARENT LSTSOURCE LISTCOUNT SELECTED LSTSELECTED ADDITEM REMOVEITEM Click, jdisplay_column Specifies the column from lookup_table to display in the drop down list. lookup_table Specifies the table to lookup the values to display in the drop down. return_column Specifies the column value to return the value property of the combo box. order_column Specifies the column to order the records displayed in the drop down list (optional). jCaption = "Bearbeiten" Height = 31 Left = 0 Top = 0 Width = 339 nappliesto = 1 Name = "tbrediting" Cqbf_table Specifies the table to query against. *parsecondition FWidth = 80 Height = 97 BorderWidth = 0 qbf_table = Name = "qbf" ontrolSource,(RATC(".",cControlSource)+1)) container parsecondition LPARAMETERS cCondition, cContr BTop = 5 Left = 135 Height = 22 Width = 0 Name = "Separator3" Separator3 separator separator jFontName = "MS Sans Serif" FontSize = 8 Height = 22 Left = 5 Top = 5 Width = 125 Name = "cboFonts" tbrediting. cboFonts combobox samples.vcx PROCEDURE KeyPress LPARAMETERS nKeyCode, nShiftAltCtrl IF nKeyCode = 63 AND nShiftAltCtrl = 1 THIS.Parent.SelectAll(THIS) ENDIF ENDPROC PROCEDURE MouseMove LPARAMETERS nButton, nShift, nXCoord, nYCoord IF nButton = 1 && Left Mouse IF ABS(nXCoord - THIS.Parent.MouseX) > THIS.Parent.DragThreshold OR ; ABS(nYCoord - THIS.Parent.MouseY) > THIS.Parent.DragThreshold THIS.Drag ENDIF ENDIF ENDPROC PROCEDURE MouseDown LPARAMETERS nButton, nShift, nXCoord, nYCoord THIS.Parent.MouseX = nXCoord THIS.Parent.MouseY = nYCoord ENDPROC PROCEDURE DragDrop LPARAMETERS oSource, nXCoord, nYCoord IF oSource.Name != THIS.Name THIS.Parent.cmdAdd.Click ENDIF ENDPROC PROCEDURE DblClick THIS.Parent.lstSource.AddItem(This.List(This.ListIndex)) This.RemoveItem(This.ListIndex) ENDPROC PROCEDURE DragOver LPARAMETERS oSource, nXCoord, nYCoord, nState DO CASE CASE nState = 0 && Enter oSource.DragIcon = THIS.Parent.CanDropIcon CASE nState = 1 && Leave oSource.DragIcon = THIS.Parent.NoDropIcon ENDCASE ENDPROC OLIST LNCNT LISTCOUNT SELECTED/ THIS LSTSOURCE DRAGICON CANDROPICON LSTSELECTED selectall, Top = 31 Left = 4 Height = 23 Width = 72 FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Caption = "\<Abfrage" Enabled = .F. TabIndex = 24 Name = "cmdExecuteQBF" distinct_values_comboa file name. cmdQBFMode toolbar %PROCEDURE KeyPress LPARAMETERS nKeyCode, nShiftAltCtrl IF nKeyCode = 63 AND nShiftAltCtrl = 1 THIS.Parent.SelectAll(THIS) ENDIF ENDPROC PROCEDURE MouseMove LPARAMETERS nButton, nShift, nXCoord, nYCoord IF nButton = 1 && Left Mouse IF ABS(nXCoord - THIS.Parent.MouseX) > THIS.Parent.DragThreshold OR ; ABS(nYCoord - THIS.Parent.MouseY) > THIS.Parent.DragThreshold THIS.Drag ENDIF ENDIF ENDPROC PROCEDURE MouseDown LPARAMETERS nButton, nShift, nXCoord, nYCoord THIS.Parent.MouseX = nXCoord THIS.Parent.MouseY = nYCoord ENDPROC PROCEDURE DragDrop LPARAMETERS oSource, nXCoord, nYCoord IF oSource.Name != THIS.Name THIS.Parent.cmdRemove.Click ENDIF ENDPROC PROCEDURE DblClick THIS.Parent.lstSelected.AddItem(This.List(This.ListIndex)) This.RemoveItem(This.ListIndex) ENDPROC PROCEDURE DragOver LPARAMETERS oSource, nXCoord, nYCoord, nState DO CASE CASE nState = 0 && Enter oSource.DragIcon = THIS.Parent.CanDropIcon CASE nState = 1 && Leave oSource.DragIcon = THIS.Parent.NoDropIcon ENDCASE ENDPROC *!* Once we h PROCEDURE Click LOCAL cFilter cFilter = "" *!* First, we need to walk all the controls on the form and find *!* all controls with a controlSource and has a value in the value property. FOR nCnt = 1 to THISFORM.ControlCount IF TYPE('THISFORM.Controls(nCnt).controlSource') <> "U" THEN IF !EMPTY(THISFORM.Controls(nCnt).ControlSource) AND ; TYPE('THISFORM.Controls(nCnt).value') <> "U" THEN *!* Now we need to parse the value property into a proper *!* condition using the parseCondition method of the form cCondition = THIS.Parent.parseCondition(THISFORM.Controls(nCnt).value,THISFORM.Controls(nCnt).controlSource) *!* If there is a condition, add it to are overall filter IF !EMPTY(cCondition) THEN cFilter = cFilter + " AND " + cCondition ENDIF ENDIF ENDIF ENDFOR *!* We need to rollback the transaction to discard the APPEND'ed record ROLLBACK THIS.Enabled = .F. THIS.Parent.cmdQBFMode.Enabled = .T. *!* This removes the " AND " keyword that is not needed for the *!* first condition added to cFilter IF !EMPTY(cFilter) THEN cFilter = ALLTRIM(SUBSTRC(cFilter,5)) ENDIF *!* Now we are ready to apply the filter SET FILTER TO &cFilter THIS.Parent.cmdClearFilter.enabled = .T. GO TOP THISFORM.Refresh ENDPROC PROCEDURE Destroy cCursor = "c" + THIS.name IF USED(cCursor) THEN USE IN &cCursor ENDIF ENDPROC PROCEDURE Init #DEFINE NO_TABLE_LOC "Der Tabellenalias mu in der ControlSource-Eigenschaft im Format 'alias.column' angegeben werden." IF !EMPTY(THIS.controlSource) THEN IF NOT "." $ THIS.controlSource THEN =MESSAGEBOX(NO_TABLE_LOC) ELSE cAlias = LEFTC(THIS.controlSource,(ATC(".",THIS.controlSource)-1)) cColumn = RIGHTC(THIS.controlSource,(LENC(THIS.controlSource)-ATC(".",THIS.controlSource))) THIS.rowSourceType = 3 cSQL = "SELECT DISTINCT " + cColumn + " FROM " + cAlias + ; " INTO CURSOR c" + THIS.name THIS.rowSource = cSQL ENDIF ENDIF ENDPROC CMCICMD CRETSTRING NRETVALUE MCISENDSTRING GETMCIERROR cErrorb *ERROR* cErrorb CERROR LCERRORSTRING NERROR CERRORSTRING MCIGETERRORSTRING MCIERROR MCIERRORSTRING No filename specified or control source specified! cFileName = ALLTRIM(&cControlSource) STATUS READY CLOSE WAIT FOXTOOLS.FLL MainHWND _WhToHwnd _WOnTop OPEN " " alias style child parent WAIT status window handle wait WINDOW state show time format milliseconds CCONTROLSOURCE CONTROLSOURCE CFILENAME VIDEOFILE CALIAS MCIALIAS MOUSEPOINTER DOMCI FOXTOOLS MAINHWND _WHTOHWND _WONTOP MAIN_HWND CUR_WINDOW NULLPOINTER MCIERROR MCIERRORSTRING X1POS Y1POS X2POS WIDTH Y2POS HEIGHT SETWINDOWPOS AUTOPLAY PLAYVIDEO STATUS length STATUS position SEEK to start WAIT PLAY CALIAS MCIALIAS NMEDIALENGTH DOMCI NMEDIAPOSITION MCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODE INTERVAL STATUS mode playing PAUSE CALIAS MCIALIAS DOMCI MCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODE INTERVAL! MCIERROR MCIERRORSTRING STATUS READY CLOSE WAIT MCIALIAS DOMCI MCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODE INTERVALg START STATUS length STATUS READY SEEK CPOSITION CALIAS MCIALIAS CPOSCMD NPOSITION NMEDIALENGTH DOMCI CLOSEVIDEO mciSendString WinMM.DLL mciGetErrorString WINMM.DLL SetWindowPos User32 MCISENDSTRING WINMM MCIGETERRORSTRING SETWINDOWPOS USER32# AUTOOPEN OPENVIDEO openvideo ltige Steuerelementquelle angegeben. NERROR CMETHOD NLINE domci, getmcierror openvideoW playvideo pausevideo" showmcierror0 closevideou setposition DestroyY Init| RefreshH Error CMCICMD CRETSTRING NRETVALUE MCISENDSTRING GETMCIERROR cErrorb *ERROR* cErrorb CERROR LCERRORSTRING NERROR CERRORSTRING MCIGETERRORSTRING MCIERROR MCIERRORSTRING! MCIERROR MCIERRORSTRINGg START STATUS length STATUS READY SEEK CPOSITION CALIAS MCIALIAS CPOSCMD NPOSITION NMEDIALENGTH DOMCI CCMDb No filename or control source specified! cFileName = ALLTRIM(&controlSource) STATUS READY CLOSE WAIT OPEN " " alias WAIT time format milliseconds CONTROLSOURCE CFILENAME SOUNDFILE CALIAS MCIALIAS MOUSEPOINTER DOMCI MCIERROR MCIERRORSTRING AUTOPLAY PLAYSOUND STATUS mode playing PAUSE CALIAS MCIALIAS DOMCI MCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODE INTERVAL STATUS length STATUS position SEEK to start WAIT PLAY CALIAS MCIALIAS NMEDIALENGTH DOMCI NMEDIAPOSITION MCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODE INTERVAL STATUS READY CLOSE WAIT MCIALIAS DOMCI MCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODE INTERVAL CLOSESOUND mciSendString WinMM.DLL mciGetErrorString WINMM.DLL SetWindowPos User32 MCISENDSTRING WINMM MCIGETERRORSTRING SETWINDOWPOS USER32# AUTOOPEN OPENSOUND opensound ltige Steuerelementquelle angegeben. NERROR CMETHOD NLINE domci, getmcierror showmcierrorW setposition opensoundY pausesoundL playsoundZ closesound Destroy Init3 Refresh ErrorA THIS TMRSWATCH ENABLED THIS TMRSWATCH ENABLED= NHOUR UPDATEDISPLAY CSECDISPLAY CMINDISPLAY CHOURDISPLAY NHOUR LBLSECONDS CAPTION LBLMINUTES LBLHOURS NHOUR UPDATEDISPLAY ELAPSEDSECONDS+ LBLSEPARATOR1 CAPTION LBLSEPARATOR2 start, stop^ reset updatedisplay increment/ Init: PROCEDURE Init #DEFINE NO_LOOKUP_TABLE_LOC "In der'lookup_table'-Eigenschaft (Kombinationsfeld " + THIS.name + ") mu eine Suchtabelle angegeben werden." #DEFINE NO_DISPLAY_COLUMN_LOC "In der 'display_column'-Eigenschaft (Kombinationsfeld " + THIS.name + ") mu eine Anzeigespalte angegeben werden." #DEFINE NO_RETURN_COLUMN_LOC "In der 'return_column'-Eigenschaft (Kombinationsfeld " + THIS.name + ") mu eine R ckgabespalte angegeben werden." lOK = .T. DO CASE CASE EMPTY(THIS.lookup_table) =MESSAGEBOX(NO_LOOKUP_TABLE_LOC,48) lOK = .F. CASE EMPTY(THIS.display_column) =MESSAGEBOX(NO_DISPLAY_COLUMN_LOC,48) lOK = .F. CASE EMPTY(THIS.return_column) =MESSAGEBOX(NO_RETURN_COLUMN_LOC,48) lOK = .F. ENDCASE IF lOK THEN IF !EMPTY(THIS.order_column) nSQL = "SELECT " + THIS.display_column + "," + THIS.return_column + " FROM " + THIS.lookup_table + " ORDER BY " + THIS.order_column + " INTO CURSOR " + THIS.name ELSE nSQL = "SELECT " + THIS.display_column + "," + THIS.return_column + " FROM " + THIS.lookup_table + " INTO CURSOR " + THIS.name ENDIF THIS.RowSourceType = 3 THIS.RowSource = nSQL THIS.BoundColumn = 2 ENDIF THIS.Refresh ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine #DEFINE INVALID_COLUMN_LOC "In der 'display_column'- oder 'return_column'-Eigenschaft (Kombinationsfeld " + THIS.name + ") wurde eine ung ltige Anzeige- oder R ckgabespalte angegeben." #DEFINE INVALID_TABLE_LOC "In der 'display_column'- oder 'lookup_table'-Eigenschaft (Kombinationsfeld " + THIS.name + ") wurde eine ung ltige Tabelle angegeben." #DEFINE INVALID_SORT_LOC "In der 'order_column'-Eigenschaft (Kombinationsfeld " + THIS.name + ") wurde eine ung ltige Spalte angegeben." DO CASE CASE nError = 1806 =MESSAGEBOX(INVALID_COLUMN_LOC,48) CASE nError = 1808 =MESSAGEBOX(INVALID_SORT_LOC,48) CASE nError = 1802 =MESSAGEBOX(INVALID_TABLE_LOC,48) OTHERWISE =MESSAGEBOX(MESSAGE(),48) ENDCASE ENDPROC PROCEDURE Destroy cAlias = THIS.name IF USED(cAlias) THEN USE IN &cAlias ENDIF ENDPROC MCISENDSTRING m.lnScopeb ltiger Wert an conflictmanager.handlerecord bergeben. SourceType Ein Wert wurde von einer/m anderen Benutzer/in ge ndert.C Feld: Datensatznummer: CCCOZ m.lcFieldb Urspr nglicher Wert: Aktueller Wert: Ihre nderung: ist ein Memofeld. chten Sie den aktuellen Wert mit Ihrer nderung berschreiben? hlen Sie 'Abbrechen', um den urspr nglichen Wert wiederherzustellen.) Datenkonflikt Ein Wert wurde ge ndert.C Feld: Datensatznummer: CCCOZ m.lcFieldb Urspr nglicher Wert: Aktueller Wert: Ihre nderung: ist ein Memofeld. chten Sie den aktuellen Wert mit Ihrer nderung berschreiben? hlen Sie 'Abbrechen', um den urspr nglichen Wert wiederherzustellen.) nderungen berpr LNSCOPE LNCHOICE LNFIELD LCFIELD LUOLDVAL LUCURVAL LUFIELD LLMADECHANGE LLSUCCESS STRING m.luValueb m.luValue Memo field LUVALUE UTYPE Buffering Buffering chten Sie Ihre nderungen speichern? nderungen speichern LNCHOICE LLMADECHANGE LNSUCCESS NOBUFF_LOC1 Buffering Buffering LNSUCCESS LNREC HANDLERECORD NOBUFF_LOC1 Buffering Buffering LNSUCCESS LLNREC HANDLERECORD NOBUFF_LOC handlerecord, stringO verifychanges verifyeachchangeN checkconflicts CFONTNAME CLEAR ASIZES LSCALABLE NLARGESTFONT NSTART NSMALLESTFONT ADDITEM filllist, WPROCEDURE start This.tmrSWatch.enabled = .T. ENDPROC PROCEDURE stop This.tmrSWatch.enabled = .f. ENDPROC PROCEDURE reset This.nSec = 0 This.nMin = 0 This.nHour = 0 This.UpdateDisplay ENDPROC PROCEDURE updatedisplay cSecDisplay = ALLTRIM(STR(This.nSec)) cMinDisplay = ALLTRIM(STR(This.nMin)) cHourDisplay = ALLTRIM(STR(This.nHour)) This.lblSeconds.Caption = IIF(This.nSec < 10, "0" + cSecDisplay , cSecDisplay) This.lblMinutes.Caption = IIF(This.nMin < 10, "0" + cMinDisplay , cMinDisplay) This.lblHours.Caption = IIF(This.nHour < 10, "0" + cHourDisplay , cHourDisplay) ENDPROC PROCEDURE increment THIS.nSec = THIS.nSec + 1 IF THIS.nSec = 60 THIS.nSec = 0 THIS.nMin = THIS.nMin + 1 ENDIF IF THIS.nMin = 60 THIS.nMin = 0 THIS.nHour = THIS.nHour + 1 ENDIF THIS.UpdateDisplay THIS.ElapsedSeconds = (THIS.nHour * 3600) + ; (THIS.nMin * 60) + ; (This.nSec) ENDPROC PROCEDURE Init #DEFINE SEPARATOR_LOC ':' This.lblSeparator1.Caption = SEPARATOR_LOC This.lblSeparator2.Caption = SEPARATOR_LOC ENDPROC PROCEDURE domci LPARAMETERS cMCIcmd *!* This method takes a MCI command string and executes it using *!* the Windows API function mciSendString *!* If the function executes successfully, the result is returned. *!* Otherwise, the error string is returned. cRetString = space(80) nRetValue = mciSendString(cMCIcmd,@cRetString,len(cRetString),0) cErr = THIS.getMCIerror(nRetValue) IF nRetValue > 0 RETURN CeRR ENDIF RETURN TRIM(STRTRAN(cRetString,chr(0),"")) ENDPROC PROCEDURE getmcierror LPARAMETERS cError LOCAL lcErrorString,nError *!* This method is called from the doMCI to retrieve the last *!* MCI error string. *!* This function also saves the last error number and string *!* into properties associated with the form. nError=0 IF TYPE("cError")="C" IF LEFT(cError,7)="*ERROR*" nError=val(substr(cError,8)) ENDIF ENDIF IF TYPE("cError")="N" nError=cError ENDIF cErrorString=SPACE(256) =mciGetErrorString(nError,@cErrorString,len(cErrorString)) THIS.MCIerror = nError THIS.MCIerrorString = cErrorString RETURN TRIM(CHRTRAN(cErrorString,CHR(0),"")) ENDPROC PROCEDURE showmcierror MESSAGEBOX(STR(THIS.MCIerror) + ": " + THIS.MCIerrorString) ENDPROC PROCEDURE setposition PARAMETERS cPosition cAlias = THIS.MCIalias IF UPPER(cPosition) = "START" or UPPER(cPosition) = "END" THEN cPosCmd = "to " + cPosition nPosition = VAL(cPosition) IF EMPTY(nPosition) THEN RETURN ELSE *!* Check to make sure position is not greater than the length nMediaLength = VAL(THIS.doMCI("STATUS " + cAlias + " length")) IF nMediaLength < nPosition THEN RETURN ELSE cPosCmd = "to " + STR(nPosition) ENDIF ENDIF ENDIF *!* Make sure video is loaded cCmd = ("STATUS " + cAlias + " READY") IF THIS.doMCI(cCmd) = "true" THEN cCmd = "SEEK " + cAlias + " " + cPosCmd THIS.doMCI(cCmd) ENDIF ENDPROC PROCEDURE opensound *!* Get needed properties into variables IF EMPTY(THIS.controlSource) THEN cFileName = THIS.soundFile IF EMPTY(cFileName) THEN MESSAGEBOX("No filename or control source specified!") RETURN ENDIF cFileName = ALLTRIM(&controlSource) IF EMPTY(cFileName) THEN RETURN ENDIF ENDIF cAlias = THIS.MCIalias IF EMPTY(cAlias) THEN cAlias = THIS.name THIS.MCIalias = cAlias ENDIF _SCREEN.MousePointer = 11 *!* If sound is already loaded, then close it cCmd = ("STATUS " + cAlias + " READY") IF THIS.doMCI(cCmd) = "true" THEN *!* If one is, close it cCMD = ("CLOSE " + cAlias + " WAIT") THIS.doMCI(cCmd) ENDIF *!* Set up open MCI command into string variable cCmd = ('OPEN "' + cFileName + '" alias ' + cAlias + ' WAIT') THIS.doMCI(cCmd) *!* Check to see if MCI command succeeded IF THIS.MCIerror > 0 THEN messagebox(THIS.MCIerrorString) _SCREEN.MousePointer = 0 RETURN ENDIF *!* Set the device to use milliseconds when setting/getting position THIS.doMCI("SET " + cAlias + " time format milliseconds") IF THIS.autoPlay = .T. THEN THIS.playSound ENDIF _SCREEN.MousePointer = 0 ENDPROC PROCEDURE pausesound cAlias = THIS.MCIalias *!* Check to see if there is media acutally playing IF THIS.doMCI("STATUS " + cAlias + " mode") = "playing" THEN *!* Yes there is, so execute the PAUSE MCI command THIS.doMCI("PAUSE " + cAlias) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 0 ENDIF ENDIF ENDPROC PROCEDURE playsound cAlias = THIS.MCIalias *!* First need to see if the media is at the end *!* by comparing the total length with the current position nMediaLength = VAL(THIS.doMCI("STATUS " + cAlias + " length")) nMediaPosition = VAL(THIS.doMCI("STATUS " + cAlias + " position")) IF nMediaPosition >= nMediaLength THEN *!* The media is at the end, so we need to seek back to the start *!* of the clip before playing THIS.doMCI("SEEK " + cAlias + " to start WAIT") ENDIF *!* Now we can play the media THIS.doMCI("PLAY " + cAlias) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 300 ENDIF ENDPROC PROCEDURE closesound *!* If sound is not already closed, then close it cCmd = ("STATUS " + THIS.MCIalias + " READY") IF THIS.doMCI(cCmd) = "true" THEN *!* If one is, close it cCMD = ("CLOSE " + THIS.MCIalias + " WAIT") THIS.doMCI(cCmd) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 0 ENDIF ENDIF ENDPROC PROCEDURE Destroy THIS.closeSound ENDPROC PROCEDURE Init *!* This is the primary Windows API function that is used to *!* send MCI commands DECLARE INTEGER mciSendString ; IN WinMM.DLL ; STRING cMCIString,; STRING @cRetString,; INTEGER nRetLength,; INTEGER hInstance *!* This function allows us to retrieve the last MCI error that occured DECLARE INTEGER mciGetErrorString ; IN WINMM.DLL ; INTEGER nErrorno, ; STRING @cBuffer, ; INTEGER nBufSize *!* When MCI plays a video, it creates its own Window. By using *!* this Windows API function we can position this Window to be *!* in the same position as our Player rectangle on the form DECLARE integer SetWindowPos ; IN User32 ; integer, integer, integer, integer, integer, integer, integer ENDPROC PROCEDURE Refresh IF THIS.autoOpen = .T. THEN THIS.openSound ENDIF ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine #DEFINE INVALID_CONTROLSOURCE_LOC "Ung ltige Steuerelementquelle angegeben." LPARAMETERS nError, cMethod, nLine DO CASE CASE nError = 12 and cMethod = "opensound" messageBox(INVALID_CONTROLSOURCE_LOC) OTHERWISE ERROR (nError) ENDCASE ENDPROC NKEYCODE NSHIFTALTCTRL PARENT SELECTALLy NBUTTON NSHIFT NXCOORD NYCOORD PARENT MOUSEX DRAGTHRESHOLD MOUSEY DRAG< NBUTTON NSHIFT NXCOORD NYCOORD PARENT MOUSEX MOUSEY= OSOURCE NXCOORD NYCOORD PARENT CMDADD CLICK6 PARENT LSTSOURCE ADDITEM LIST LISTINDEX REMOVEITEMu OSOURCE NXCOORD NYCOORD NSTATE DRAGICON PARENT CANDROPICON NODROPICON KeyPress, MouseMove MouseDownw DragDrop DblClickw DragOver NKEYCODE NSHIFTALTCTRL PARENT SELECTALLy NBUTTON NSHIFT NXCOORD NYCOORD PARENT MOUSEX DRAGTHRESHOLD MOUSEY DRAG< NBUTTON NSHIFT NXCOORD NYCOORD PARENT MOUSEX MOUSEY= OSOURCE NXCOORD NYCOORD PARENT CMDREMOVE CLICK6 PARENT LSTSELECTED ADDITEM LIST LISTINDEX REMOVEITEMu OSOURCE NXCOORD NYCOORD NSTATE DRAGICON PARENT CANDROPICON NODROPICON KeyPress, MouseMove MouseDownw DragDrop DblClickz DragOver CCCC^ CCCCC^ CCCC$%Z CCCC$iZ PARENT TIMEFORMAT TXTTIME VALUE TXTDATE Timer, PARENT NHOUR UPDATEDISPLAY ELAPSEDSECONDS Timer, ButtonCount = 3 BackStyle = 0 Value = 1 Height = 110 Left = 10 Top = 14 Width = 242 Name = "opgReportOutput" OPTION1.FontBold = .F. OPTION1.FontName = "MS Sans Serif" OPTION1.FontSize = 8 Option1.BackStyle = 0 OPTION1.Caption = "Seitenvorschau" OPTION1.Value = 1 OPTION1.Height = 15 OPTION1.Left = 11 OPTION1.Top = 12 OPTION1.Width = 80 OPTION1.AutoSize = .T. Option1.Name = "optPreview" OPTION2.FontBold = .F. OPTION2.FontName = "MS Sans Serif" OPTION2.FontSize = 8 Option2.BackStyle = 0 OPTION2.Caption = "Drucker" OPTION2.Value = 0 OPTION2.Height = 15 OPTION2.Left = 11 OPTION2.Top = 30 OPTION2.Width = 48 OPTION2.AutoSize = .T. Option2.Name = "optPrinter" OPTION3.FontBold = .F. OPTION3.FontName = "MS Sans Serif" OPTION3.FontSize = 8 Option3.BackStyle = 0 OPTION3.Caption = "Datei" OPTION3.Value = 0 OPTION3.Height = 15 OPTION3.Left = 11 OPTION3.Top = 48 OPTION3.Width = 34 OPTION3.AutoSize = .T. Option3.Name = "optFile" ow or column position is off the screen. PROCEDURE Init #DEFINE REPORT_NOT_FOUND_LOC "Die Berichtdatei '" + THISFORM.cReport +"' existiert nicht." + CHR(13) + CHR(13) + "Sie m ssen eine g ltige Berichtdatei angeben, die in der cReport-Eigenschaft des Formulars gedruckt oder als Parameter bergeben wird." #DEFINE NO_REPORT_LOC "Der zu druckende Bericht mu in der cReport-Eigenschaft des Formulars angegeben sein oder als Parameter bergeben werden." LPARAMETERS cRepName *!* If no parameters are passed in, the variables are automatically *!* set to a logical .F. value. IF TYPE("cRepName") = "C" THEN *!* If a parameter is passed in, assume it is the report *!* name and set the cReport property of the form to it. THISFORM.cReport = cRepName ENDIF IF EMPTY(THISFORM.cReport) THEN MESSAGEBOX(NO_REPORT_LOC) RETURN .F. ENDIF IF !FILE(THISFORM.cReport) THEN MESSAGEBOX(REPORT_NOT_FOUND_LOC) RETURN .F. ENDIF ENDPROC d contains unrecognized PROCEDURE InteractiveChange IF TYPE("_SCREEN.ActiveForm") = 'O' oForm = _SCREEN.ActiveForm RETURN ENDIF DO CASE CASE THIS.Parent.nAppliesTo = 1 && Current Control oForm.ActiveControl.FontSize = VAL(THIS.Value) CASE THIS.Parent.nAppliesTo = 2 && All textboxes and editboxes oForm.SetAll('FontSize', VAL(THIS.Value), 'TEXTBOX') oForm.SetAll('FontSize', VAL(THIS.Value), 'EDITBOX') CASE THIS.Parent.nAppliesTo = 3 && All Controls oForm.SetAll('FontSize', VAL(THIS.Value)) ENDCASE ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine #define NUM_LOC "Fehlernummer: " #define PROG_LOC "Prozedur: " #define MSG_LOC "Fehlermeldung: " #define CR_LOC CHR(13) #define BADSIZE_LOC "Das Steuerelement unterst tzt den ausgew hlten Schriftgrad nicht." DO CASE CASE nError = 1881 && Fontsize invalid for the control WAIT WINDOW BADSIZE_LOC TIMEOUT 2 IF TYPE("Application.ActiveForm.ActiveControl") = "O" THIS.Parent.Refresh(Application.ActiveForm.ActiveControl) 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 Refresh LPARAMETERS oSource DO CASE CASE THIS.nAppliesTo = 2 && text and edit boxes IF TYPE("_SCREEN.ActiveForm") = 'O' oForm = _SCREEN.ActiveForm ELSE RETURN ENDIF FOR i = 1 to oForm.ControlCount IF oForm.Controls(i).BaseClass$"Textbox Editbox" THIS.cboFonts.Value = oForm.Controls(i).FontName THIS.cboSizes.FillList(THIS.cboFonts.Value) THIS.cboSizes.Value = STR(oForm.Controls(i).FontSize) THIS.chkBold.Value = oForm.Controls(i).FontBold THIS.chkItalic.Value = oForm.Controls(i).FontItalic THIS.chkUnderline.Value = oForm.Controls(i).FontUnderline EXIT ENDIF ENDFOR OTHERWISE IF TYPE("oSource") != 'O' RETURN ENDIF THIS.cboFonts.Value = oSource.FontName THIS.cboSizes.FillList(THIS.cboFonts.Value) THIS.cboSizes.Value = STR(oSource.FontSize) THIS.chkBold.Value = oSource.FontBold THIS.chkItalic.Value = oSource.FontItalic THIS.chkUnderline.Value = oSource.FontUnderline ENDCASE ENDPROC PROCEDURE Destroy This.Visible = .F. ENDPROC INITIALIZE_AND_ADJUST ADJUST INITIALRESIZE LOOPTHROUGHCONTROLS oControl.FontSizeb OCONTROL ACONTROLSTATS INITIALFORMHEIGHT INITIALFORMWIDTH HEIGHT WIDTH FONTSIZE Textbox Spinner OCONTROL THISFORM HEIGHT ACONTROLSTATS WIDTH BASECLASS DECIMALv Commandbutton Combobox Checkbox Listbox Form Grid Textbox Label Shape Editbox Olecontrol Pageframe Image Spinner INITIALIZE_AND_ADJUST ADJUST Pageframe Commandbutton Combobox Checkbox Listbox Form Grid Textbox Label Shape Editbox Olecontrol Pageframe Image Spinner INITIALIZE_AND_ADJUST ADJUST CTASK NOLDDECIMAL THISFORM LOCKSCREEN CONTROLCOUNT OCONTROL CONTROLS BASECLASS ADDTOARRAY SETSIZE PAGECOUNT PAGES INITIALFORMHEIGHT THISFORM HEIGHT INITIALFORMWIDTH WIDTH' INITIALRESIZE ACONTROLSTATS adjustcontrols, addtoarray setsizeJ loopthroughcontrols` reset THIS TMRSWATCH ENABLED THIS TMRSWATCH ENABLED= NHOUR UPDATEDISPLAY CSECDISPLAY CMINDISPLAY CHOURDISPLAY NHOUR LBLSECONDS CAPTION LBLMINUTES LBLHOURS* NHOUR start, stop^ Reset updatedisplay Init/ PARENT NHOUR UPDATEDISPLAY ELAPSEDSECONDS Timer, THIS TMRSWATCH ENABLED THIS TMRSWATCH ENABLED= NHOUR UPDATEDISPLAY CSECDISPLAY CMINDISPLAY CHOURDISPLAY NHOUR LBLSECONDS CAPTION LBLMINUTES LBLHOURS* NHOUR start, stop^ Reset updatedisplay Init/ ".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 "Ung ltiger Wert an conflictmanager.handlerecord bergeben." WAIT WINDOW WINDMSG_LOC ENDIF * Declare constants & variables #define CR_LOC CHR(13) #define SAVE_LOC "M chten Sie den aktuellen Wert mit Ihrer nderung berschreiben?" + CR_LOC + "(W hlen Sie 'Abbrechen', um den urspr nglichen Wert wiederherzustellen.)" #define CONFLICT_LOC "Datenkonflikt" #define VERIFY_LOC " nderungen berpr #define ORG_LOC "Urspr nglicher Wert: " #define CUR_LOC "Aktueller Wert: " #define CHG_LOC "Ihre nderung: " #define MEMO_LOC " ist ein Memofeld." #define FIELD_LOC "Feld: " #define RECORD_LOC "Datensatznummer: " #define VALCHG1_LOC "Ein Wert wurde von einer/m anderen Benutzer/in ge ndert." #define VALCHG2_LOC "Ein Wert wurde ge ndert." 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) 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 'M chten Sie Ihre nderungen speichern?' #define SAVECHG2_LOC ' nderungen speichern' #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 'Zwischenspeichern von Daten nicht aktiviert.' 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 WINDOW VPROCEDURE domci LPARAMETERS cMCIcmd *!* This method takes a MCI command string and executes it using *!* the Windows API function mciSendString *!* If the function executes successfully, the result is returned. *!* Otherwise, the error string is returned. cRetString = space(80) nRetValue = mciSendString(cMCIcmd,@cRetString,len(cRetString),0) cErr = THIS.getMCIerror(nRetValue) IF nRetValue > 0 RETURN CeRR ENDIF RETURN TRIM(STRTRAN(cRetString,chr(0),"")) ENDPROC PROCEDURE getmcierror LPARAMETERS cError LOCAL lcErrorString,nError *!* This method is called from the doMCI to retrieve the last *!* MCI error string. *!* This function also saves the last error number and string *!* into properties associated with the form. nError=0 IF TYPE("cError")="C" IF LEFT(cError,7)="*ERROR*" nError=val(substr(cError,8)) ENDIF ENDIF IF TYPE("cError")="N" nError=cError ENDIF cErrorString=SPACE(256) =mciGetErrorString(nError,@cErrorString,len(cErrorString)) THIS.MCIerror = nError THIS.MCIerrorString = cErrorString RETURN TRIM(CHRTRAN(cErrorString,CHR(0),"")) ENDPROC PROCEDURE openvideo *!* Get needed properties into variables cControlSource = THIS.controlSource IF EMPTY(cControlSource) THEN cFileName = THIS.videoFile IF EMPTY(cFileName) THEN MESSAGEBOX("No filename specified or control source specified!") RETURN ENDIF cFileName = ALLTRIM(&cControlSource) IF EMPTY(cFileName) THEN RETURN ENDIF ENDIF cAlias = THIS.MCIalias IF EMPTY(cAlias) THEN cAlias = THIS.name THIS.MCIalias = cAlias ENDIF _SCREEN.MousePointer = 11 *!* If video is already loaded, then close it cCmd = ("STATUS " + cAlias + " READY") IF THIS.doMCI(cCmd) = "true" THEN *!* If one is, close it cCMD = ("CLOSE " + cAlias + " WAIT") THIS.doMCI(cCmd) ENDIF *!* Need to use window handle functions in FoxTools *!* SET LIBRARY TO HOME() + ".\FOXTOOLS.FLL" PR SET LIBRARY to FOXTOOLS.FLL EXTERNAL PROCEDURE MainHWND EXTERNAL PROCEDURE _WhToHwnd EXTERNAL PROCEDURE _WOnTop * Returns Handle of Main VFP Window Main_hWnd = MainHWND() * Get Handle of the form with FOXTOOLS.FLL cur_window = _WhToHwnd(_WOnTop()) NullPointer = 0 *!* Set up open MCI command into string variable cCmd = ('OPEN "' + cFileName + '" alias ' + cAlias + ; ' style child parent ' + ALLTRIM(STR(cur_window)) + ' WAIT') THIS.doMCI(cCmd) *!* Check to see if MCI command succeeded IF THIS.MCIerror > 0 THEN messagebox(THIS.MCIerrorString) _SCREEN.MousePointer = 0 RETURN *!* It does have visual media, so we need to set up the window *!* it will play in. *!* Get the window handle of the window playing the video cCmd = "status " + cAlias + " window handle wait" hWin = INT(VAL(THIS.doMCI(cCmd))) *!* Once we have the window handle, we need to position *!* the video window to be the same position and size *!* as our player rectangle on the form x1Pos = THIS.LEFT y1Pos = THIS.TOP x2Pos = x1Pos + THIS.WIDTH y2Pos = y1Pos + THIS.HEIGHT *!* Use the SetWindowPos Windows function to set position and size setWindowPos(hWin,0,x1Pos,y1Pos,x2Pos,y2Pos,0) *!* Everything's done, let's show the video cCmd = ("WINDOW " + cAlias + " state show") THIS.doMCI(cCmd) ENDIF *!* Set the device to use milliseconds when setting/getting position THIS.doMCI("SET " + cAlias + " time format milliseconds") IF THIS.autoPlay = .T. THEN THIS.playVideo ENDIF _SCREEN.MousePointer = 0 ENDPROC PROCEDURE playvideo cAlias = THIS.MCIalias *!* First need to see if the media is at the end *!* by comparing the total length with the current position nMediaLength = VAL(THIS.doMCI("STATUS " + cAlias + " length")) nMediaPosition = VAL(THIS.doMCI("STATUS " + cAlias + " position")) IF nMediaPosition >= nMediaLength THEN *!* The media is at the end, so we need to seek back to the start *!* of the clip before playing THIS.doMCI("SEEK " + cAlias + " to start WAIT") ENDIF *!* Now we can play the media THIS.doMCI("PLAY " + cAlias) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 100 ENDIF ENDPROC PROCEDURE pausevideo cAlias = THIS.MCIalias *!* Check to see if there is media acutally playing IF THIS.doMCI("STATUS " + cAlias + " mode") = "playing" THEN *!* Yes there is, so execute the PAUSE MCI command THIS.doMCI("PAUSE " + cAlias) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 0 ENDIF ENDIF ENDPROC PROCEDURE showmcierror MESSAGEBOX(STR(THIS.MCIerror) + ": " + THIS.MCIerrorString) ENDPROC PROCEDURE closevideo *!* If video is not already closed, then close it cCmd = ("STATUS " + THIS.MCIalias + " READY") IF THIS.doMCI(cCmd) = "true" THEN *!* If one is, close it cCMD = ("CLOSE " + THIS.MCIalias + " WAIT") THIS.doMCI(cCmd) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 0 ENDIF ENDIF ENDPROC PROCEDURE setposition PARAMETERS cPosition cAlias = THIS.MCIalias IF UPPER(cPosition) = "START" or UPPER(cPosition) = "END" THEN cPosCmd = "to " + cPosition nPosition = VAL(cPosition) IF EMPTY(nPosition) THEN RETURN ELSE *!* Check to make sure position is not greater than the length nMediaLength = VAL(THIS.doMCI("STATUS " + cAlias + " length")) IF nMediaLength < nPosition THEN RETURN ELSE cPosCmd = "to " + STR(nPosition) ENDIF ENDIF ENDIF *!* Make sure video is loaded cCmd = ("STATUS " + cAlias + " READY") IF THIS.doMCI(cCmd) = "true" THEN cCmd = "SEEK " + cAlias + " " + cPosCmd THIS.doMCI(cCmd) ENDIF ENDPROC PROCEDURE Destroy THIS.closeVideo ENDPROC PROCEDURE Init *!* This is the primary Windows API function that is used to *!* send MCI commands DECLARE INTEGER mciSendString ; IN WinMM.DLL ; STRING cMCIString,; STRING @cRetString,; INTEGER nRetLength,; INTEGER hInstance *!* This function allows us to retrieve the last MCI error that occured DECLARE INTEGER mciGetErrorString ; IN WINMM.DLL ; INTEGER nErrorno, ; STRING @cBuffer, ; INTEGER nBufSize *!* When MCI plays a video, it creates its own Window. By using *!* this Windows API function we can position this Window to be *!* in the same position as our Player rectangle on the form DECLARE integer SetWindowPos ; IN User32 ; integer, integer, integer, integer, integer, integer, integer ENDPROC PROCEDURE Refresh IF THIS.autoOpen = .T. THEN THIS.openVideo ENDIF ENDPROC PROCEDURE Error #DEFINE INVALID_CONTROLSOURCE_LOC "Ung ltige Steuerelementquelle angegeben." LPARAMETERS nError, cMethod, nLine DO CASE CASE nError = 12 and cMethod = "openvideo" messageBox(INVALID_CONTROLSOURCE_LOC) OTHERWISE ERROR (nError) ENDCASE ENDPROC gimmicks\dmovie\dmovie.prg c:\temp\ dmovie.fxp gimmicks\dmovie\ dmovie.scx gimmicks\dmovie\ dmovie.sct gimmicks\dmovie\icons\ dooropen.ico paint_4.ico arw01rt.ico msgbox01.ico gimmicks\dmovie\readme.prg readme.fxp klassen\graphics\ h_point.cur klassen\ _multimedia.vcx klassen\ _multimedia.vct klassen\ _base.vcx klassen\ _base.vct klassen\setobjrf.prg setobjrf.fxp gimmicks\dmovie\ samples.vcx gimmicks\dmovie\ samples.vct