Programming Languages Suite

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

/ Programming Languages Suite / ProgLangD.iso / FOXP-WIN.300 / DISK5 / VFP5.CAB / 30UPDATE.PRG next >

Wrap

Text File | 1995-01-11 | 87.6 KB | 2,984 lines

#define c_debug .t. #define FOXPRO_BUILD_ID 344 #define MB_OK 0 #define MB_OKCANCEL 1 #define MB_ABORTRETRYIGNORE 2 #define MB_YESNOCANCEL 3 #define MB_YESNO 4 #define MB_RETRYCANCEL 5 #define MB_TYPEMASK 15 #define MB_ICONHAND 16 #define MB_ICONQUESTION 32 #define MB_ICONEXCLAMATION 48 #define MB_ICONASTERISK 64 #define MB_ICONMASK 240 #define MB_ICONINFORMATION 64 #define MB_ICONSTOP 16 #define MB_DEFBUTTON1 0 #define MB_DEFBUTTON2 256 #define MB_DEFBUTTON3 512 #define MB_DEFMASK 3840 #define MB_APPLMODAL 0 #define MB_SYSTEMMODAL 4096 #define MB_TASKMODAL 8192 #define MB_NOFOCUS 32768 #define m_MsgBoxTitle 'FoxPro 3.0 Updater' #define m_Not30Scx ' is not a 3.0 .SCX!' #define m_Not30Dbc ' is not a 3.0 .DBC!' #define m_Not30Pjx ' is not a 3.0 .PJX!' #define m_NotComment 'Record #1 is not a COMMENT record.' #define c_crlf chr(13)+chr(10) #define e_InvalidParameter 'Invalid argument type.' #define e_ScxNotFound ' not found.' parameters m.cScxName private aEnvironment dimension aEnvironment[1] clear do ScxUpdtrSetup do ScxUpdtrMain do ScxUpdtrCleanup ******************* procedure UpdatePjx ******************* parameters m.cPjxName, m.lNotify private cPath, lIs30Pjx m.cPath=justpath(m.cPjxName) set default to (m.cPath) use (m.cPjxName) alias PjxFile m.lIs30Pjx=.f. do case case type('PjxFile.name')<>'M' case type('PjxFile.type')<>'C' case type('PjxFile.timestamp')<>'N' case type('PjxFile.outfile')<>'M' case type('PjxFile.homedir')<>'M' case type('PjxFile.exclude')<>'L' case type('PjxFile.mainprog')<>'L' case type('PjxFile.savecode')<>'L' case type('PjxFile.debug')<>'L' case type('PjxFile.encrypt')<>'L' case type('PjxFile.nologo')<>'L' case type('PjxFile.cmntstyle')<>'N' case type('PjxFile.objrev')<>'N' case type('PjxFile.commands')<>'M' case type('PjxFile.devinfo')<>'M' case type('PjxFile.symbols')<>'M' case type('PjxFile.object')<>'M' case type('PjxFile.ckval')<>'N' case type('PjxFile.cpid')<>'N' case type('PjxFile.ostype')<>'C' case type('PjxFile.oscreator')<>'C' case type('PjxFile.comments')<>'M' case type('PjxFile.reserved1')<>'M' case type('PjxFile.reserved2')<>'M' otherwise m.lIs30Pjx=.t. endcase if !m.lIs30Pjx =Alert(m.cPjxName+m_Not30Pjx) else if m.lNotify activate screen ?'Updating '+m.cPjxName+'... ' endif CREATE CURSOR PjxFile2 ; (name m(10,0), ; type c(1,0), ; timestamp n(10,0), ; outfile m(10,0), ; homedir m(10,0), ; exclude l(1,0), ; mainprog l(1,0), ; savecode l(1,0), ; debug l(1,0), ; encrypt l(1,0), ; nologo l(1,0), ; cmntstyle n(1,0), ; objrev n(5,0), ; commands m(10,0), ; devinfo m(10,0), ; symbols m(10,0), ; object m(10,0), ; ckval n(6,0), ; cpid n(5,0), ; ostype c(4,0), ; oscreator c(4,0), ; comments m(10,0), ; reserved1 m(10,0), ; reserved2 m(10,0), ; key c(32), ; user m(10, 0)) use in PjxFile select PjxFile2 append from (m.cPjxName) for !deleted() m.lSuccess = .t. locate for type = 'H' if !found() =Alert('Project '+m.cPjxFile+' has no header record.') m.lSuccess = .f. else m.iVersion = objrev endif do while m.lSuccess do case case m.iVersion = 257 .and. OkToBuild(245) delete for type = 'S' replace type with 'K' for type = 's' replace all key with left(justfname(name), 32) locate for type = 'H' replace objrev with 258 m.iVersion = 258 case m.iVersion = 258 .and. OkToBuild(275) * Add a USER field to the .PJX structure--the field has been added * to the CREATE CURSOR statement above. locate for type = 'H' replace objrev with 259 m.iVersion = 259 otherwise exit endcase enddo if m.lSuccess copy to (m.cPjxName) for !deleted() use in PjxFile2 m.cOnError=on('error') m.iError=0 on error m.iError=error() * Rebuild project? on error &cOnError if !empty(m.iError) =Alert('Error #'+alltrim(str(m.iError))+' occurred '+ ; 'building '+m.cPjxName+'.') endif else use in PjxFile2 endif if m.lNotify activate screen if m.lSuccess ??'Complete.' else ??'Skipped.' endif endif endif ******************** procedure UpdateScx ******************** parameters m.cScxName, m.lNotify private m.iSelect, m.lIs30Scx, m.cExact, m.i, ; m.lTxt2Edt, m.iVersion, m.cProperty, m.cLine, ; m.cUpdatedProperties, m.cUpdatedMethods, m.lDeclares m.cPath=justpath(m.cScxName) set default to (m.cPath) use (m.cScxName) alias ScxFile m.lIs30Scx=.f. do case case type('ScxFile.platform')<>'C' case type('ScxFile.uniqueid ')<>'C' case type('ScxFile.timestamp')<>'N' case type('ScxFile.reserved1')<>'M' case type('ScxFile.reserved2')<>'M' case type('ScxFile.reserved3')<>'M' case type('ScxFile.user')<>'M' case type('ScxFile.comment')<>'M' case type('ScxFile.class')<>'C' .and. type('ScxFile.class')<>'M' case type('ScxFile.classloc')<>'M' case type('ScxFile.objname')<>'M' case type('ScxFile.parent')<>'M' case type('ScxFile.properties')<>'M' case type('ScxFile.methods')<>'M' case type('ScxFile.objcode')<>'M' otherwise m.lIs30Scx=.t. endcase if !m.lIs30Scx =Alert(m.cScxName+m_Not30Scx) else if m.lNotify activate screen ?'Updating '+m.cScxName+'... ' endif * RESERVED6 - RESERVED10 added for version .026 create cursor ScxFile2 ; ( platform c(8), ; uniqueid c(10), ; timestamp n(10), ; class m, ; classloc m, ; baseclass m, ; objname m, ; parent m, ; properties m, ; protected m, ; methods m, ; objcode m, ; declares m, ; declares2 m, ; ole m, ; ole2 m, ; comment m, ; reserved1 m, ; reserved2 m, ; reserved3 m, ; reserved4 m, ; reserved5 m, ; reserved6 m, ; reserved7 m, ; reserved8 m, ; reserved9 m, ; reserved10 m, ; user m) select ScxFile go top if platform='COMMENT' .and. (upper(uniqueid)='SCREEN' .or. ; upper(uniqueid)='CLASS') m.iVersion=val(setting(reserved1,'version')) m.cType=upper(alltrim(uniqueid)) else insert into ScxFile2 ; (platform, uniqueid) ; values ('COMMENT','Screen') m.iVersion=0 m.cType='SCREEN' endif use in ScxFile select ScxFile2 if m.cType='SCREEN' append from (m.cScxName) else append from (m.cScxName) for .not. deleted() endif replace all objcode with '' m.lSuccess=.t. do while .t. do case case m.iVersion < .005 replace all class with alltrim(class) locate for lower(alltrim(class))='fieldbox' m.lTxt2Edt=iif(found(),.t.,.f.) if type('ScxFile.declares')<>'M' m.lTxt2Edit=.t. endif if m.lTxt2Edt replace class with 'editbox' for lower(alltrim(class))='textbox' replace class with 'textbox' for lower(alltrim(class))='fieldbox' endif m.cFormSetName='' m.cFormName='' scan * Fill in Objname if it's empty if empty(ScxFile2.objname) replace objname with setting(properties,'Name') endif * Update current formset and form names if upper(class)='FORMSET' m.cFormSetName=objname endif if upper(class)='FORM' m.cFormName=objname endif * Fill in Parent if it's empty if empty(ScxFile2.parent) do case case upper(class)='FORMSET' * formset doesn't have a parent case upper(class)='FORM' replace parent with m.cFormSetName otherwise replace parent with m.cFormSetName+'.'+m.cFormName endcase endif endscan * write the version number =UpdateVersion('VERSION = 0.005') m.iVersion = .005 case m.iVersion = .005 * Apply quotes to DATATEXT properties of .SCX and .VCX files m.cDataTextList= ; ',CAPTION,CHILDORDER,CLIP,COLUMNWIDTHS,COLOR,COMMENT,DATASOURCE'+ ; ',DATASOURCEOBJ,DATATYPE,FONT,FONTNAME,FORMAT,FROM<ARRAY>,FUNCTION'+ ; ',INPUTMASK,LINKMASTER,LINKTOPIC,LIST,LISTSOURCE,<MEMVAR>|<FIELD>'+ ; ',OPTIONVALUE,PASSWORDCHAR,PICTURE,SOURCE,STATUSBARTEXT,TAB,TAG,TEXT'+ ; ',VALIDATIONRULE,VALIDATIONTEXT,WINDOW,WINDOWLIST,WINDOWNTILIST,NAME'+ ; ',PALETTESOURCE,XBACKCOLOR,XFORECOLOR,XFORECOLOR,XFONTSIZE,XFONTSTYLE'+ ; ',XALIGNMENT,' scan for platform='WINDOWS' _mline=0 m.cUpdatedProperties='' for m.i=1 to memlines(properties) m.cLine=mline(properties,1,_mline) if empty(m.cLine) loop endif m.cProperty=alltrim(left(m.cLine,at('=',m.cLine)-1)) if '.'$m.cProperty m.cPropertyName=substr(m.cProperty,rat('.',m.cProperty)+1) else m.cPropertyName=m.cProperty endif if ','+upper(alltrim(m.cPropertyName))+','$m.cDataTextList m.cValue=substr(m.cLine,at('=',m.cLine)+1) if left(m.cValue,1)=' ' m.cValue=substr(m.cValue,2) endif do case case ["]$m.cValue .and. [']$m.cValue .and. ; ('['$m.cValue .or. ']'$m.cValue) && TBD && The form tool currently slaps [] around strings like && this--we'll address the issue in a later version. m.cValue='['+m.cValue+']' case .not. ["]$m.cValue m.cValue=["]+m.cValue+["] case .not. [']$m.cValue m.cValue=[']+m.cValue+['] otherwise m.cValue='['+m.cValue+']' endcase m.cUpdatedProperties=m.cUpdatedProperties+ ; m.cProperty+' = '+m.cValue+c_crlf else m.cUpdatedProperties=m.cUpdatedProperties+ ; m.cLine+c_crlf endif endfor replace properties with m.cUpdatedProperties endscan release aProperties =UpdateVersion('VERSION = 0.006') m.iVersion = .006 case m.iVersion = .006 .and. m.cType='CLASS' scan for upper(alltrim(parent))=='CLASS' m.iRecno=recno() do case case upper(alltrim(class))=='CONTROLS' skip m.iTimestamp=timestamp m.cUniqueID=sys(2015) do while .t. m.cUniqueID=sys(2015) locate for alltrim(uniqueid)==m.cUniqueID if !found() exit endif enddo go (m.iRecno) replace platform with 'WINDOWS', ; reserved2 with alltrim(str(timestamp+1)), ; reserved1 with 'Class', ; parent with '', ; timestamp with m.iTimestamp, ; uniqueid with m.cUniqueID otherwise m.iCount=timestamp m.cObjname=objname m.cComment=comment skip m.cOldObjname=upper(alltrim(objname)) replace reserved1 with 'Class', ; reserved2 with alltrim(str(m.iCount)), ; objname with m.cObjname, ; comment with m.cComment scan while .not. upper(alltrim(parent))=='CLASS' if upper(alltrim(parent))==m.cOldObjname replace parent with m.cObjname endif endscan go (m.iRecno) delete endcase endscan =UpdateVersion('VERSION = 0.007') m.iVersion = .007 case (m.iVersion = .006 .and. m.cType='SCREEN') .or. ; (m.iVersion = .007 .and. m.cType='CLASS') && Change "Gridcolumn" to "Column" and "Gridcolumnheader" to "Header" scan for alltrim(class)=='grid' m.cUpdatedProperties='' _mline=0 for m.i=1 to memlines(properties) m.cLine=mline(properties,1,_mline) if empty(m.cLine) loop endif m.cProperty=alltrim(left(m.cLine,at('=',m.cLine)-1)) do case case 'Gridcolumn'$m.cProperty m.cProperty=strtran( ; strtran(m.cProperty,'Gridcolumnheader','Header'), ; 'Gridcolumn','Column') m.cUpdatedProperties=m.cUpdatedProperties+ ; m.cProperty+' '+substr(m.cLine,at('=',m.cLine))+c_crlf otherwise m.cUpdatedProperties=m.cUpdatedProperties+m.cLine+c_crlf endcase endfor replace properties with m.cUpdatedProperties endscan if m.iVersion = .006 m.iVersion=.007 =UpdateVersion('VERSION = 0.007') else m.iVersion=.008 =UpdateVersion('VERSION = 0.008') endif case (m.iVersion = .007 .and. m.cType='SCREEN') .or. ; (m.iVersion = .008 .and. m.cType='CLASS') && combine Grid.HGridLines and Grid.VGridLines into Grid.GridLines and && Grid.HScrollBar and Grid.VScrollBar into Grid.ScrollBars scan for alltrim(class)=='grid' m.cUpdatedProperties='' _mline=0 m.VGridLines=.t. && default m.HGridLines=.t. && default m.VScrollBar=.t. && default m.HScrollBar=.t. && default for m.i=1 to memlines(properties) m.cLine=mline(properties,1,_mline) if empty(m.cLine) loop endif m.cProperty=alltrim(left(m.cLine,at('=',m.cLine)-1)) do case case m.cProperty='HScrollBar' m.HScrollBar=evaluate(substr(m.cLine,at('=',m.cLine)+1)) case m.cProperty='VScrollBar' m.VScrollBar=evaluate(substr(m.cLine,at('=',m.cLine)+1)) case m.cProperty='VGridLines' m.VGridLines=evaluate(substr(m.cLine,at('=',m.cLine)+1)) case m.cProperty='HGridLines' m.HGridLines=evaluate(substr(m.cLine,at('=',m.cLine)+1)) otherwise m.cUpdatedProperties=m.cUpdatedProperties+m.cLine+c_crlf endcase endfor do case case .not. HGridLines .and. .not. VGridLines m.cUpdatedProperties=m.cUpdatedProperties+ ; 'GridLines = 0'+c_crlf case HGridLines .and. .not. VGridLines m.cUpdatedProperties=m.cUpdatedProperties+ ; 'GridLines = 1'+c_crlf case .not. HGridLines .and. VGridLines m.cUpdatedProperties=m.cUpdatedProperties+ ; 'GridLines = 2'+c_crlf otherwise && nothing, both (3) is the default endcase do case case .not. HScrollBar .and. .not. VScrollBar m.cUpdatedProperties=m.cUpdatedProperties+ ; 'ScrollBars = 0'+c_crlf case HScrollBar .and. .not. VScrollBar m.cUpdatedProperties=m.cUpdatedProperties+ ; 'ScrollBars = 1'+c_crlf case .not. HScrollBar .and. VScrollBar m.cUpdatedProperties=m.cUpdatedProperties+ ; 'ScrollBars = 2'+c_crlf otherwise && nothing, both (3) is the default endcase replace properties with m.cUpdatedProperties endscan if m.iVersion = .007 m.iVersion=.008 =UpdateVersion('VERSION = 0.008') else m.iVersion=.009 =UpdateVersion('VERSION = 0.009') endif case (m.iVersion = .008 .and. m.cType='SCREEN') .or. ; (m.iVersion = .009 .and. m.cType='CLASS') && Rename default name of controls: && Commandbutton Command && Optionbutton Option && Listbox List && Combobox Combo && Editbox Edit && Textbox Text && Checkbox Check scan for empty(classloc) .and. !empty(class) m.cUpdatedProperties='' _mline=0 for m.i=1 to memlines(properties) m.cLine=mline(properties,1,_mline) if empty(m.cLine) loop endif m.cProperty=alltrim(left(m.cLine,at('=',m.cLine)-1)) m.cProperty=strtran(m.cProperty,'Commandbutton','Command') m.cProperty=strtran(m.cProperty,'Optionbutton','Option') m.cProperty=strtran(m.cProperty,'Listbox','List') m.cProperty=strtran(m.cProperty,'Combobox','Combo') m.cProperty=strtran(m.cProperty,'Editbox','Edit') m.cProperty=strtran(m.cProperty,'Textbox','Text') m.cProperty=strtran(m.cProperty,'Checkbox','Check') m.cUpdatedProperties=m.cUpdatedProperties+ ; m.cProperty+' '+substr(m.cLine,at('=',m.cLine))+c_crlf endfor replace properties with m.cUpdatedProperties endscan if m.iVersion = .008 m.iVersion=.009 =UpdateVersion('VERSION = 0.009') else m.iVersion=.010 =UpdateVersion('VERSION = 0.010') endif case (m.iVersion = .009 .and. m.cType='SCREEN') .or. ; (m.iVersion = .010 .and. m.cType='CLASS') && Update BASECLASS memo field with FoxPro base class if !used('classes') create cursor classes ; (class m, classloc m, baseclass m) insert into classes values ('checkbox','','') insert into classes values ('combobox','','') insert into classes values ('commandbutton','','') insert into classes values ('commandgroup','','') insert into classes values ('controls','','') insert into classes values ('editbox','','') insert into classes values ('form','','') insert into classes values ('formset','','') insert into classes values ('grid','','') insert into classes values ('image','','') insert into classes values ('label','','') insert into classes values ('line','','') insert into classes values ('listbox','','') insert into classes values ('olecontrol','','') insert into classes values ('optionbutton','','') insert into classes values ('optiongroup','','') insert into classes values ('pageframe','','') insert into classes values ('shape','','') insert into classes values ('spinner','','') insert into classes values ('textbox','','') insert into classes values ('timer','','') replace all baseclass with class select ScxFile2 endif scan for !empty(class) m.cClass=class m.cClassLoc=iif(empty(classloc),'',fullpath(classloc)) m.cBaseClass='' do while .t. select classes locate for class==m.cClass .and. classloc==m.cClassLoc if found() m.cBaseClass=baseclass exit endif do case case empty(m.cClassLoc) =Alert(m.cScxName+' record #'+alltrim(str(recno('ScxFile2')))+': '+ ; upper(m.cClass)+' is not a FoxPro base class.') m.lSuccess=.f. exit case !file(m.cClassLoc) =Alert(m.cScxName+' record #'+alltrim(str(recno('ScxFile2')))+': '+ ; 'file '+m.cClassLoc+' does not exist.') m.lSuccess=.f. exit otherwise select 0 m.cOnError=on('error') on error * use (m.cClassLoc) again on error &cOnError if !empty(alias()) locate for reserved1='Class' .and. upper(m.cClass)==upper(objname) if found() if type('baseclass')='M' .and. !empty(baseclass) m.cClass=ScxFile2.class m.cClassLoc=iif(empty(classloc),'',fullpath(classloc)) m.cBaseClass=baseclass insert into classes ; values (m.cClass, m.cClassLoc, m.cBaseClass) use exit else m.cClass=class m.cClassLoc=iif(empty(classloc),'',fullpath(classloc)) use loop endif else =Alert(m.cScxName+' record #'+alltrim(str(recno('ScxFile2')))+': '+ ; 'unable to locate class '+upper(m.cClass)+' in '+dbf()+'.') m.lSuccess=.f. use exit endif else =Alert(m.cScxName+' record #'+alltrim(str(recno('ScxFile2')))+': '+ ; 'an error occurred opening '+m.cClassLoc+'.') m.lSuccess=.f. exit endif endcase enddo if !m.lSuccess exit endif if empty(m.cBaseClass) =Alert(m.cScxName+' record #'+alltrim(str(recno('ScxFile2')))+': '+ ; 'unable to determine BASECLASS.') exit && let the user pick a class? endif select ScxFile2 replace baseclass with m.cBaseClass endscan if !m.lSuccess exit endif m.iVersion = .011 =UpdateVersion('VERSION = 0.011') case m.iVersion = .011 && BASECLASS field in .SCX/.VCX was written with default name, not class name-- && change default control names to class names. replace baseclass with 'commandbutton' for 'command'=lower(baseclass) replace baseclass with 'listbox' for 'list'=lower(baseclass) replace baseclass with 'combobox' for 'combo'=lower(baseclass) replace baseclass with 'editbox' for 'edit'=lower(baseclass) replace baseclass with 'textbox' for 'text'=lower(baseclass) replace baseclass with 'checkbox' for 'check'=lower(baseclass) scan for empty(classloc) .and. !empty(class) m.cUpdatedProperties='' _mline=0 for m.i=1 to memlines(properties) m.cLine=mline(properties,1,_mline) if empty(m.cLine) loop endif m.cProperty=alltrim(left(m.cLine,at('=',m.cLine)-1)) m.cProperty=strtran(m.cProperty,'Commandbutton','Command') m.cProperty=strtran(m.cProperty,'Optionbutton','Option') m.cProperty=strtran(m.cProperty,'Listbox','List') m.cProperty=strtran(m.cProperty,'Combobox','Combo') m.cProperty=strtran(m.cProperty,'Editbox','Edit') m.cProperty=strtran(m.cProperty,'Textbox','Text') m.cProperty=strtran(m.cProperty,'Checkbox','Check') m.cUpdatedProperties=m.cUpdatedProperties+ ; m.cProperty+' '+substr(m.cLine,at('=',m.cLine))+c_crlf endfor replace properties with m.cUpdatedProperties endscan m.iVersion=.012 =UpdateVersion('VERSION = 0.012') case m.iVersion = .012 scan for Reserved1<>'Class' .and. !empty(reserved1) replace declares2 with reserved1 replace reserved1 with '' endscan m.iVersion=.013 =UpdateVersion('VERSION = 0.013') case m.iVersion = .013 .and. OkToBuild(208) && rename the CONTROLS class to CONTAINER replace class with 'container' for lower(class)='controls' replace baseclass with 'container' for lower(baseclass)='controls' m.iVersion=.014 =UpdateVersion('VERSION = 0.014') case m.iVersion = .014 .and. OkToBuild(209) && Rename Bitmap property to Picture scan for 'Bitmap'$properties m.cUpdatedProperties='' _mline=0 for m.i=1 to memlines(properties) m.cLine=mline(properties,1,_mline) m.cProperty=alltrim(left(m.cLine,at('=',m.cLine)-1)) do case case empty(m.cLine) loop case 'Bitmap' $ m.cProperty m.cProperty=strtran(m.cProperty,'Bitmap','Picture') m.cUpdatedProperties = m.cUpdatedProperties + m.cProperty + ' ' + ; substr(m.cLine,at('=',m.cLine)) + c_crlf otherwise m.cUpdatedProperties=m.cUpdatedProperties+m.cLine+c_crlf endcase endfor replace properties with m.cUpdatedProperties endscan && Remove Control0 references scan for inlist(baseclass,'commandgroup','optiongroup','pageframe') m.cUpdatedProperties='' _mline=0 for m.i=1 to memlines(properties) m.cLine=mline(properties,1,_mline) m.cProperty=alltrim(left(m.cLine,at('=',m.cLine)-1)) do case case empty(m.cLine) loop case baseclass='commandgroup' .and. 'Command0.'$m.cProperty loop case baseclass='optiongroup' .and. 'Option0.'$m.cProperty loop case baseclass='pageframe' .and. 'Formpage0.'$m.cProperty loop otherwise if baseclass='pageframe' m.cProperty=strtran(m.cProperty,'Formpage','Page') m.cUpdatedProperties=m.cUpdatedProperties+m.cProperty+' '+ ; substr(m.cLine,at('=',m.cLine))+c_crlf else m.cUpdatedProperties=m.cUpdatedProperties+m.cLine+c_crlf endif endcase endfor replace properties with m.cUpdatedProperties endscan m.iVersion = .015 =UpdateVersion('VERSION = 0.015') case m.iVersion = .015 .and. OkToBuild(227) && Rename properties: && Pageframe.Pages to Pageframe.NumPages && Grid.Columns to Grid.NumColumns && Commandgroup.Buttons to Commandgroup.NumButtons && Optiongroup.Buttons to Optiongroup.Buttons scan for inlist(baseclass,'pageframe','grid','commandgroup','optiongroup') m.cUpdatedProperties='' _mline=0 for m.i=1 to memlines(properties) m.cLine=mline(properties,1,_mline) m.cProperty=alltrim(left(m.cLine,at('=',m.cLine)-1)) do case case empty(m.cLine) loop case baseclass='pageframe' .and. m.cProperty=='Pages' m.cUpdatedProperties=m.cUpdatedProperties+'NumPages '+ ; substr(m.cLine,at('=',m.cLine))+c_crlf case baseclass='grid' .and. m.cProperty=='Columns' m.cUpdatedProperties=m.cUpdatedProperties+'NumColumns '+ ; substr(m.cLine,at('=',m.cLine))+c_crlf case inlist(baseclass,'commandgroup','optiongroup') ; .and. m.cProperty=='Buttons' m.cUpdatedProperties=m.cUpdatedProperties+'NumButtons '+ ; substr(m.cLine,at('=',m.cLine))+c_crlf otherwise m.cUpdatedProperties=m.cUpdatedProperties+m.cLine+c_crlf endcase endfor replace properties with m.cUpdatedProperties endscan m.iVersion = .016 =UpdateVersion('VERSION = 0.016') case m.iVersion = .016 .and. OkToBuild(240) && Rename methods: && grid.column.GOTRESIZED is now RESIZED && grid.column.GOTMOVED is now MOVED && grid.DELETE is now DELETED && Rename properties: && grid.NUMCOLUMNS is now COLUMNCOUNT scan for baseclass='grid' m.cUpdatedProperties='' _mline=0 for m.i=1 to memlines(properties) m.cLine=mline(properties,1,_mline) if empty(m.cLine) loop endif m.cProperty=alltrim(left(m.cLine,at('=',m.cLine)-1)) if m.cProperty=='NumColumns' m.cUpdatedProperties=m.cUpdatedProperties+'ColumnCount '+ ; substr(m.cLine,at('=',m.cLine))+c_crlf else m.cUpdatedProperties=m.cUpdatedProperties+m.cLine+c_crlf endif endfor replace properties with m.cUpdatedProperties m.cUpdatedMethods = '' _mline = 0 for m.i = 1 to memlines(methods) m.cLine = mline(methods, 1, _mline) if left(m.cLine, 10) == 'PROCEDURE ' m.cProcedure = substr(m.cLine, 11) do case case m.cProcedure == 'Delete' m.cUpdatedMethods = m.cUpdatedMethods + ; 'PROCEDURE Deleted' + c_crlf case occurs('.GotMoved', m.cProcedure) = 1 m.cUpdatedMethods = m.cUpdatedMethods + ; strtran(m.cLine, '.GotMoved', '.Moved') + c_crlf case occurs('.GotResized', m.cProcedure) = 1 m.cUpdatedMethods = m.cUpdatedMethods + ; strtran(m.cLine, '.GotResized', '.Resized') + c_crlf otherwise m.cUpdatedMethods = m.cUpdatedMethods + m.cLine + c_crlf endcase else m.cUpdatedMethods = m.cUpdatedMethods + m.cLine + c_crlf endif endfor * strip off extra crlf if right(m.cUpdatedMethods,4) = c_crlf + c_crlf m.cUpdatedMethods = ; left(m.cUpdatedMethods, len(m.cUpdatedMethods) - len(c_crlf)) endif replace methods with m.cUpdatedMethods endscan m.iVersion = .017 =UpdateVersion('VERSION = 0.017') case m.iVersion = .017 .and. OkToBuild(245) && Rename the Grid.SourceType property to Grid.DataSourceType scan for baseclass='grid' m.cUpdatedProperties='' _mline=0 for m.i=1 to memlines(properties) m.cLine=mline(properties,1,_mline) if empty(m.cLine) loop endif m.cProperty=alltrim(left(m.cLine,at('=',m.cLine)-1)) if m.cProperty=='SourceType' m.cUpdatedProperties=m.cUpdatedProperties+'DataSourceType '+ ; substr(m.cLine,at('=',m.cLine))+c_crlf else m.cUpdatedProperties=m.cUpdatedProperties+m.cLine+c_crlf endif endfor replace properties with m.cUpdatedProperties endscan m.iVersion = .018 =UpdateVersion('VERSION = 0.018') case m.iVersion = .018 .and. OkToBuild(248) && Drop the DECLARES and DECLARES2 memo fields. Create a && file with DEC extension if code is found in DECLARES. private m.cDeclares, m.lOverwrite m.cDeclares = '' scan for !empty(declares) m.cDeclares = m.cDeclares + ; '*** code found in ' + objname + ; '.declares' + c_crlf + c_crlf + declares + c_crlf + c_crlf endscan if !empty(m.cDeclares) m.lOverwrite = .t. if file(forceext(m.cScxName, 'TXT')) if Alert('File ' + m.cScxName + ' contains code in the ' + ; 'DECLARES memo field and this field is being removed from ' + ; 'the .SCX/.VCX structure. ' + c_crlf + c_crlf + ; '30Update would like to write ' + ; 'this code to ' + forceext(m.cScxName, 'TXT') + ', but that ' + ; 'file exists. Overwrite the file?', ; MB_YESNO+MB_ICONEXCLAMATION) = 'NO' m.lOverwrite = .f. if Alert('Do you want to continue updating this file? ' + ; 'If you continue, the code found in the DECLARES memo ' + ; 'field will not be saved.', MB_YESNO + MB_ICONEXCLAMATION) = 'NO' m.lSuccess = .f. exit endif endif endif if m.lOverwrite = .t. m.iHandle = fcreate(forceext(m.cScxName, 'TXT')) if m.iHandle = -1 =Alert('An error occurred opening ' + ; forceext(m.cScxName, 'TXT') + ; '. This file will be skipped.') m.lSuccess = .f. exit endif =fwrite(m.iHandle, m.cDeclares) =fclose(m.iHandle) ??'Code found in DECLARES written to ' + ; forceext(m.cScxName, 'TXT') + '... ' endif replace all declares with '', declares2 with '' endif && Rename properties: && Textbox, Editbox: && HighForeColor to SelectedForeColor && HighBackColor to SelectedBackColor scan for inlist(baseclass, 'textbox', 'editbox') m.cUpdatedProperties='' _mline=0 for m.i=1 to memlines(properties) m.cLine=mline(properties,1,_mline) if empty(m.cLine) loop endif m.cProperty=alltrim(left(m.cLine,at('=',m.cLine)-1)) do case case m.cProperty == 'HighForeColor' m.cUpdatedProperties = m.cUpdatedProperties + 'SelectedForeColor ' + ; substr(m.cLine, at('=', m.cLine)) + c_crlf case m.cProperty == 'HighBackColor' m.cUpdatedProperties = m.cUpdatedProperties + 'SelectedBackColor ' + ; substr(m.cLine, at('=', m.cLine)) + c_crlf otherwise m.cUpdatedProperties=m.cUpdatedProperties+m.cLine+c_crlf endcase endfor replace properties with m.cUpdatedProperties endscan m.iVersion = .019 =UpdateVersion('VERSION = 0.019') case m.iVersion = .019 .and. OkToBuild(261) * Rename the following properties: * Pageframe.NumPages to PageCount * Optiongroup.NumButtons to ButtonCount * Commandgroup.NumButtons to ButtonCount * Grid.Column2.Header2 to Grid.Column2.Header1 * Grid.Column3.Header3 to Grid.Column3.Header1 scan for inlist(baseclass, 'pageframe', 'optiongroup', 'commandgroup', 'grid') m.cUpdatedProperties='' _mline=0 for m.i=1 to memlines(properties) m.cLine=mline(properties,1,_mline) if empty(m.cLine) loop endif m.cProperty=alltrim(left(m.cLine,at('=',m.cLine)-1)) do case case baseclass = 'pageframe' .and. m.cProperty == 'NumPages' m.cUpdatedProperties = m.cUpdatedProperties + 'PageCount ' + ; substr(m.cLine, at('=', m.cLine)) + c_crlf case inlist(baseclass, 'optiongroup', 'commandgroup') .and. ; m.cProperty == 'NumButtons' m.cUpdatedProperties = m.cUpdatedProperties + 'ButtonCount ' + ; substr(m.cLine, at('=', m.cLine)) + c_crlf case baseclass = 'grid' .and. 'Column' $ m.cProperty .and. ; '.Header' $ m.cProperty m.cHeader = substr(m.cProperty, at('.', m.cProperty)) m.cHeader = left(m.cHeader, at('.', m.cHeader, 2)) m.cUpdatedProperties = m.cUpdatedProperties + ; strtran(m.cProperty, m.cHeader, '.Header1.') + ' ' +; substr(m.cLine, at('=', m.cLine)) + c_crlf otherwise m.cUpdatedProperties=m.cUpdatedProperties+m.cLine+c_crlf endcase endfor replace properties with m.cUpdatedProperties endscan m.iVersion = .020 =UpdateVersion('VERSION = 0.020') case m.iVersion = .020 .and. OkToBuild(270) * Remove Cursor.WorkArea and Cursor.SourceType from properties * Remove ClassLibrary property from properties * Rename "datanavigation" class to "dataenvironment" * Default name changed from DataNavigation to DataEnvironment * (existing objects are not renamed--this is information only) replace baseclass with "dataenvironment" for baseclass = "datanavigation" replace class with "dataenvironment" for class = "datanavigation" .and. ; baseclass = "dataenvironment" scan for baseclass = "cursor" m.cUpdatedProperties='' _mline=0 for m.i=1 to memlines(properties) m.cLine=mline(properties,1,_mline) if empty(m.cLine) loop endif m.cProperty=alltrim(left(m.cLine,at('=',m.cLine)-1)) if inlist(m.cProperty, "WorkArea", "SourceType") loop else m.cUpdatedProperties=m.cUpdatedProperties+m.cLine+c_crlf endif endfor replace properties with m.cUpdatedProperties endscan scan for "ClassLocation = " $ properties m.cUpdatedProperties='' _mline=0 for m.i=1 to memlines(properties) m.cLine=mline(properties,1,_mline) if empty(m.cLine) loop endif m.cProperty=alltrim(left(m.cLine,at('=',m.cLine)-1)) if m.cProperty = "ClassLocation" loop else m.cUpdatedProperties=m.cUpdatedProperties+m.cLine+c_crlf endif endfor replace properties with m.cUpdatedProperties endscan m.iVersion = .021 =UpdateVersion('VERSION = 0.021') case m.iVersion = .021 .and. OkToBuild(275) * Rename the Pageframe.ActiveFormPage property to ActivePage scan for inlist(baseclass, 'pageframe') m.cUpdatedProperties='' _mline=0 for m.i=1 to memlines(properties) m.cLine=mline(properties,1,_mline) if empty(m.cLine) loop endif m.cProperty=alltrim(left(m.cLine,at('=',m.cLine)-1)) do case case baseclass = 'pageframe' .and. m.cProperty == 'ActiveFormPage' m.cUpdatedProperties = m.cUpdatedProperties + 'ActivePage ' + ; substr(m.cLine, at('=', m.cLine)) + c_crlf otherwise m.cUpdatedProperties=m.cUpdatedProperties+m.cLine+c_crlf endcase endfor replace properties with m.cUpdatedProperties endscan * Rename the Grid.ActiveCell method to Grid.ActivateCell scan for baseclass='grid' m.cUpdatedMethods = '' _mline = 0 for m.i = 1 to memlines(methods) m.cLine = mline(methods, 1, _mline) if left(m.cLine, 10) == 'PROCEDURE ' m.cProcedure = substr(m.cLine, 11) do case case m.cProcedure == 'ActiveCell' m.cUpdatedMethods = m.cUpdatedMethods + ; 'PROCEDURE ActivateCell' + c_crlf otherwise m.cUpdatedMethods = m.cUpdatedMethods + m.cLine + c_crlf endcase else m.cUpdatedMethods = m.cUpdatedMethods + m.cLine + c_crlf endif endfor * strip off extra crlf if right(m.cUpdatedMethods,4) = c_crlf + c_crlf m.cUpdatedMethods = ; left(m.cUpdatedMethods, len(m.cUpdatedMethods) - len(c_crlf)) endif replace methods with m.cUpdatedMethods endscan m.iVersion = .022 =UpdateVersion('VERSION = 0.022') case m.iVersion = .022 .and. OkToBuild(280) * Rename properties: * * Class Old Name New Name * ===== ======== ======== * Listbox, Combobox ListSource RowSource * ListSourceType RowSourceType * * Grid DataSource RecordSource * DataSourceType RecordSourceType * * All except Grid DataSource ControlSource * (including Column) * * Combobox, Listbox BorderForeColor BorderColor scan for !empty(properties) m.cUpdatedProperties='' _mline=0 for m.i=1 to memlines(properties) m.cLine=mline(properties,1,_mline) if empty(m.cLine) loop endif m.cProperty=alltrim(left(m.cLine,at('=',m.cLine)-1)) do case case 'DataSource' $ m.cProperty if baseclass = 'grid' * This should handle both DataSource and DataSourceType renaming m.cProperty = strtran(m.cProperty, '.DataSource', '.ControlSource') m.cProperty = strtran(m.cProperty, 'DataSource', 'RecordSource') m.cUpdatedProperties = m.cUpdatedProperties + ; m.cProperty + ' '+ substr(m.cLine, at('=', m.cLine)) + c_crlf else m.cUpdatedProperties = m.cUpdatedProperties + ; strtran(m.cProperty, 'DataSource', 'ControlSource') + ' ' + ; substr(m.cLine, at('=', m.cLine)) + c_crlf endif case inlist(baseclass, 'listbox', 'combobox') .and. 'ListSource' $ m.cProperty * This should handle both ListSource and ListSourceType renaming m.cUpdatedProperties = m.cUpdatedProperties + ; strtran(m.cProperty, 'ListSource', 'RowSource') + ' ' + ; substr(m.cLine, at('=', m.cLine)) + c_crlf case inlist(baseclass, 'listbox', 'combobox') .and. 'BorderForeColor' $ m.cProperty m.cUpdatedProperties = m.cUpdatedProperties + ; strtran(m.cProperty, 'BorderForeColor', 'BorderColor') + ' ' + ; substr(m.cLine, at('=', m.cLine)) + c_crlf otherwise m.cUpdatedProperties = m.cUpdatedProperties + m.cLine + c_crlf endcase endfor replace properties with m.cUpdatedProperties endscan m.iVersion = .023 =UpdateVersion('VERSION = 0.023') case m.iVersion = .023 .and. OkToBuild(285) && Remove the Shape.Shape property && No attempt is made to maintain the shape of the shape scan for baseclass = 'shape' m.cUpdatedProperties = '' _mline=0 for m.i=1 to memlines(properties) m.cLine = mline(properties, 1, _mline) if empty(m.cLine) loop endif m.cProperty = alltrim(left(m.cLine, at('=', m.cLine) - 1)) do case case m.cProperty = 'Shape' loop otherwise m.cUpdatedProperties = m.cUpdatedProperties + m.cLine + c_crlf endcase endfor replace properties with m.cUpdatedProperties endscan m.iVersion = .024 =UpdateVersion('VERSION = 0.024') case m.iVersion = .024 .and. OkToBuild(296) * Convert control coordinates so they're relative to the container * Process the file in descending Parent order so we adjust children's coordinates * before we adjust parent's coordinates index on recno() tag recno descending m.lIgnoreError = .f. scan for !empty(baseclass) .and. ; !inlist(baseclass, 'formset', 'form', 'toolbar', 'dataenvironment', 'header') m.lUpdated = .f. * if this is an optiongroup or commandgroup, update the coordinates of the * buttons in the group if inlist(baseclass, 'optiongroup', 'commandgroup') m.iGroupTop = val(GetProperty(properties, 'Top')) m.iGroupLeft = val(GetProperty(properties, 'Left')) for m.i = 1 to val(GetProperty(properties, 'ButtonCount')) m.cButtonName = ; iif(baseclass == 'commandgroup', 'Command', 'Option') + alltrim(str(m.i)) replace properties with PutProperty(properties, m.cButtonName + '.Top', ; alltrim(str(val(GetProperty(properties, m.cButtonName + '.Top')) - m.iGroupTop))) replace properties with PutProperty(properties, m.cButtonName + '.Left', ; alltrim(str(val(GetProperty(properties, m.cButtonName + '.Left')) - m.iGroupLeft))) endfor endif * if this is a container, update the coordinates of the controls in the container if inlist(baseclass, 'container') m.iContainerTop = val(GetProperty(properties, 'Top')) m.iContainerLeft = val(GetProperty(properties, 'Left')) m.cUpdatedProperties = '' _mline = 0 for m.iLine = memlines(properties) to 1 step -1 m.cLine = mline(properties, m.iLine) if empty(m.cLine) loop endif m.cProperty = alltrim(left(m.cLine, at('=', m.cLine) - 1)) if '.' $ m.cProperty .and. inlist(substr(m.cProperty, rat('.', m.cProperty) + 1), 'Top', 'Left') m.iCoord = val(substr(m.cLine, at('=', m.cLine) + 1)) m.cControlName = left(m.cProperty, rat('.', m.cProperty) - 1) m.cParentName = left(m.cControlName, rat('.', m.cControlName) - 1) m.cProperty = substr(m.cProperty, rat('.', m.cProperty) + 1) if !empty(m.cParentName) m.iParentCoord = val(GetProperty(properties, m.cParentName + '.' + m.cProperty)) else m.iParentCoord = m.iContainer&cProperty endif m.cUpdatedProperties = m.cControlName + '.' + m.cProperty + ' = ' + ; alltrim(str(m.iCoord - m.iParentCoord)) + c_crlf + m.cUpdatedProperties else m.cUpdatedProperties = m.cLine + c_crlf + m.cUpdatedProperties endif endfor replace properties with m.cUpdatedProperties endif * BugBug: Does the same thing have to be done for toolbars that we've done for * optiongroups, commandgroups, and containers? * Record the record number we'll return to m.iRecord = recno() * Store the parent and objname for this record m.cParent = alltrim(parent) m.cObjName = alltrim(objname) * Peel off the name of the container of this object m.cContainer = alltrim(iif('.' $ parent, ; substr(parent, rat('.', parent) + 1), parent)) * Store the container's parent m.cContainerParent = left(m.cParent, rat('.', m.cParent) - 1) * Peel off the name of the container's container m.cContainerContainer = alltrim(iif('.' $ m.cContainerParent, ; substr(m.cContainerParent, rat('.', m.cContainerParent) + 1), ; m.cContainerParent)) * Finally, store the container's container's parent m.cContainerContainerParent = ; left(m.cContainerParent, rat('.', m.cContainerParent) - 1) skip do while !eof() * Is this the container? if m.cContainer == objname .and. m.cContainerParent == parent exit endif * Is this the container's container? if m.cContainerContainer == objname .and. m.cContainerContainerParent == parent * If this is a pageframe, treat it as the control's container if baseclass == 'pageframe' exit endif * If this is a grid, nevermind if baseclass == 'grid' m.lUpdated = .t. exit endif endif *********************************** if .f. if empty(parent) * We're at the end of the line for this form/class * Go back and look for the container's Top and Left properties in the * containers along the parent go (m.iRecord) skip m.cExact = set('exact') set exact off do while !eof() * is this a container along the parent? if m.cParent = iif(!empty(parent), alltrim(parent) + '.', '') + alltrim(objname) * strip off the objname and look for Top and Left properties m.cTempParent = ; strtran(m.cParent, iif(!empty(parent), alltrim(parent) + '.', '') + alltrim(objname) + '.') if m.cTempParent + '.Top =' $ properties .or. ; m.cTempParent + '.Left =' $ properties * get the parent's top and left coordinates m.iParentTop = val(GetProperty(properties, m.cTempParent + '.Top')) m.iParentLeft = val(GetProperty(properties, m.cTempParent + '.Left')) go (m.iRecord) * update the child's top and left coordinates using the parent's coordinates replace properties with PutProperty(properties, 'Top', ; alltrim(str(val(GetProperty(properties, 'Top')) - m.iParentTop))) replace properties with PutProperty(properties, 'Left', ; alltrim(str(val(GetProperty(properties, 'Left')) - m.iParentLeft))) m.lUpdated = .t. exit endif endif if empty(parent) * Try one more time, stripping off the control's container (it could * be a formpage) go (m.iRecord) skip do while !eof() * is this a container along the parent? if m.cParent = iif(!empty(parent), alltrim(parent) + '.', '') + alltrim(objname) * strip off the objname and innermost container and * look for Top and Left properties m.cTempParent = ; strtran(m.cParent, iif(!empty(parent), alltrim(parent) + '.', '') + alltrim(objname) + '.') m.cTempParent = left(m.cTempParent, rat('.', m.cTempParent) - 1) if m.cTempParent + '.Top =' $ properties .or. ; m.cTempParent + '.Left =' $ properties * get the parent's top and left coordinates m.iParentTop = val(GetProperty(properties, m.cTempParent + '.Top')) m.iParentLeft = val(GetProperty(properties, m.cTempParent + '.Left')) go (m.iRecord) * update the child's top and left coordinates using the parent's coordinates replace properties with PutProperty(properties, 'Top', ; alltrim(str(val(GetProperty(properties, 'Top')) - m.iParentTop))) replace properties with PutProperty(properties, 'Left', ; alltrim(str(val(GetProperty(properties, 'Left')) - m.iParentLeft))) m.lUpdated = .t. exit endif endif if empty(parent) go bottom skip exit endif if !eof() skip endif enddo if m.lUpdated exit endif endif if !eof() skip endif enddo set exact &cExact if m.lUpdated exit endif endif endif *********************************** if !eof() skip endif enddo if m.lUpdated m.lUpdated = .f. loop endif if !eof() if !inlist(baseclass, 'formset', 'form', 'toolbar') * get the parent's top and left coordinates m.iParentTop = val(GetProperty(properties, 'Top')) m.iParentLeft = val(GetProperty(properties, 'Left')) * if the control is on a formpage, adjust for the tabs if Tabs = .T. * we're not attempting to account for the bordersize or specialeffect, * so this will probably be off a few pixels if baseclass == 'pageframe' if GetProperty(properties, 'Tabs') <> '.F.' m.iParentTop = m.iParentTop + 23 endif endif go (m.iRecord) * update the child's top and left coordinates using the parent's coordinates replace properties with PutProperty(properties, 'Top', ; alltrim(str(val(GetProperty(properties, 'Top')) - m.iParentTop))) replace properties with PutProperty(properties, 'Left', ; alltrim(str(val(GetProperty(properties, 'Left')) - m.iParentLeft))) else go (m.iRecord) endif else * something's wrong! go (m.iRecord) if .not. m.lIgnoreError if 'YES' = Alert('Record #' + alltrim(str(recno())) + ': ' + alltrim(parent) + ; iif(!empty(parent), '.', '') + alltrim(objname) + ' parent not found. ' + ; 'Continue updating? (If you answer Yes, further errors will not be displayed. If you '+ ; 'answer No, the file will be skipped.)', MB_ICONEXCLAMATION + MB_YESNO) m.lIgnoreError = .t. else m.lSuccess = .f. exit endif endif endif endscan delete tag recno m.iVersion = .025 =UpdateVersion('VERSION = 0.025') case m.iVersion = .025 .and. OkToBuild(316) *** Version .026 Modifications *** * Add columns RESERVED6 - RESERVED 10 * (this change was made to the CREATE CURSOR at the beginning * of this procedure) scan for !empty(baseclass) * Move class description to RESERVED7 if m.cType == 'CLASS' .and. empty(parent) replace reserved7 with comment, comment with '', ; reserved6 with 'Pixels' endif m.cUpdatedProperties = '' _mline=0 for m.i=1 to memlines(properties) m.cLine = mline(properties, 1, _mline) if empty(m.cLine) loop endif m.cProperty = alltrim(left(m.cLine, at('=', m.cLine) - 1)) m.cJustProperty = iif('.' $ m.cProperty, ; substr(m.cProperty, rat('.', m.cProperty) + 1), ; m.cProperty) m.cValue = alltrim(substr(m.cLine, at('=', m.cLine) + 1)) do case case m.cJustProperty = 'FontTransparent' * Remove all references to FontTransparent loop case m.cJustProperty = 'MultiSession' * Rename MultiSession property to DataSession m.cUpdatedProperties = m.cUpdatedProperties + ; strtran(m.cProperty, 'MultiSession', 'DataSession') + ; ' = ' + iif('T' $ upper(m.cValue), '2', '1') + c_crlf case inlist(baseclass, 'form', 'toolbar') .and. ; m.cProperty = 'ScaleMode' * Drop this, we'll add it to the top, below loop case inlist(baseclass, 'form') .and. m.cProperty = 'Sizable' * Drop the Sizable property loop case m.cJustProperty = 'ScaleMode' * Force the ScaleMode to 3 (Pixels) m.cUpdatedProperties = m.cUpdatedProperties + ; m.cProperty + ' = 3' + c_crlf case m.cJustProperty = 'Index' * Remove all references to Index property loop case m.cJustProperty = 'HideColumns' * Rename HideColumn property to ColumnLines m.cUpdatedProperties = m.cUpdatedProperties + ; strtran(m.cLine, 'HideColumns', 'ColumnLines') + c_crlf case inlist(baseclass, 'listbox', 'combobox') .and. ; m.cJustProperty = 'Columns' * Rename Columns property to ColumnCount m.cUpdatedProperties = m.cUpdatedProperties + ; strtran(m.cLine, 'Columns', 'ColumnCount') + c_crlf case m.cJustProperty = 'DecimalPoints' * Remove all references to DecimalPoints property loop case m.cJustProperty = 'AllowTabs' * Remove AllowTabs references--this is textboxes only, * but do it always to catch classes. loop case m.cJustProperty = 'ButtonIndex' * Remove ButtonIndex references loop case inlist(baseclass, 'container', 'control') .and. ; m.cJustProperty = 'ControlSource' * Remove ControlSource references loop case m.cJustProperty = 'ColorScheme' * Force the ColorScheme to a valid value do case case val(m.cValue) < 1 m.cUpdatedProperties = m.cUpdatedProperties + ; m.cProperty + ' = 1' + c_crlf case val(m.cValue) > 24 m.cUpdatedProperties = m.cUpdatedProperties + ; m.cProperty + ' = 24' + c_crlf otherwise m.cUpdatedProperties = m.cUpdatedProperties + ; m.cLine + c_crlf endcase case m.cJustProperty = 'BoundColumn' * Force the BoundColumn to a valid value do case case val(m.cValue) < 1 m.cUpdatedProperties = m.cUpdatedProperties + ; m.cProperty + ' = 1' + c_crlf otherwise m.cUpdatedProperties = m.cUpdatedProperties + ; m.cLine + c_crlf endcase case m.cJustProperty = 'Margin' * Force the Margin to a valid value do case case val(m.cValue) < 0 m.cUpdatedProperties = m.cUpdatedProperties + ; m.cProperty + ' = 0' + c_crlf otherwise m.cUpdatedProperties = m.cUpdatedProperties + ; m.cLine + c_crlf endcase case m.cJustProperty = 'ColorSource' * Force the ColorSource to a valid value (0 - 3) do case case val(m.cValue) < 0 m.cUpdatedProperties = m.cUpdatedProperties + ; m.cProperty + ' = 0' + c_crlf case val(m.cValue) > 3 m.cUpdatedProperties = m.cUpdatedProperties + ; m.cProperty + ' = 3' + c_crlf otherwise m.cUpdatedProperties = m.cUpdatedProperties + ; m.cLine + c_crlf endcase case m.cJustProperty = 'Stretch' * Change .F. to 0, .T. to 1 if lower(m.cValue) = '.f.' m.cUpdatedProperties = m.cUpdatedProperties + ; m.cProperty + ' = 0' + c_crlf else m.cUpdatedProperties = m.cUpdatedProperties + ; m.cProperty + ' = 1' + c_crlf endif otherwise m.cUpdatedProperties = m.cUpdatedProperties + m.cLine + c_crlf endcase endfor if inlist(baseclass, 'form', 'toolbar') * Add "ScaleMode = 3" to the top of the properties m.cUpdatedProperties = "ScaleMode = 3" + c_crlf + m.cUpdatedProperties endif replace properties with m.cUpdatedProperties endscan * Re-format Reserved3 and write Protected properties/methods to Protected scan for !empty(Reserved3) m.cReserved3 = '' m.cProtected = '' _mline=0 for m.i=1 to memlines(reserved3) m.cLine = mline(reserved3, 1, _mline) if empty(m.cLine) loop endif m.lProtected = .f. if left(m.cLine, 10) == 'PROTECTED ' m.cLine = substr(m.cLine, 11) m.lProtected = .t. endif do case case left(m.cLine, 1) = '*' case '=' $ m.cLine m.cLine = alltrim(left(m.cLine, at('=', m.cLine) - 1)) otherwise loop endcase m.cReserved3 = m.cReserved3 + m.cLine + c_crlf if m.lProtected m.cProtected = m.cProtected + m.cLine + c_crlf endif endfor replace reserved3 with m.cReserved3, protected with m.cProtected endscan m.iVersion = .026 =UpdateVersion('VERSION = 0.026') case m.iVersion = .026 .and. OkToBuild(336) *** Version .027 Modifications *** scan for !empty(baseclass) m.cUpdatedProperties = '' _mline=0 for m.i = 1 to memlines(properties) m.cLine = mline(properties, 1, _mline) if empty(m.cLine) loop endif m.cProperty = alltrim(left(m.cLine, at('=', m.cLine) - 1)) m.cJustProperty = iif('.' $ m.cProperty, ; substr(m.cProperty, rat('.', m.cProperty) + 1), ; m.cProperty) m.cValue = alltrim(substr(m.cLine, at('=', m.cLine) + 1)) do case case m.cJustProperty = 'Visible' * Remove Formpage.Visible property. * Look for "Page9." preceding the property name if '.' $ m.cProperty m.cControl = left(m.cProperty, rat('.', m.cProperty) - 1) if '.' $ m.cControl m.cControl = substr(m.cControl, rat('.', m.cControl) + 1) endif if left(m.cControl, 4) = 'Page' .and. isdigit(substr(m.cControl, 5, 1)) loop endif endif * Otherwise, keep the property m.cUpdatedProperties = m.cUpdatedProperties + m.cLine + c_crlf case m.cJustProperty = 'ParentIndexExpr' * Relation property renamed to RelationalExpr (not used elsewhere) m.cUpdatedProperties = m.cUpdatedProperties + ; strtran(m.cLine, 'ParentIndexExpr = ', 'RelationalExpr = ') + ; c_crlf case m.cJustProperty = 'ChildIndexTag' * Relation property renamed to ChildOrder (not used elsewhere) m.cUpdatedProperties = m.cUpdatedProperties + ; strtran(m.cLine, 'ChildIndexTag = ', 'ChildOrder = ') + ; c_crlf otherwise m.cUpdatedProperties = m.cUpdatedProperties + m.cLine + c_crlf endcase endfor replace properties with m.cUpdatedProperties endscan scan for baseclass='grid' m.cUpdatedMethods = '' _mline = 0 for m.i = 1 to memlines(methods) m.cLine = mline(methods, 1, _mline) if left(m.cLine, 10) == 'PROCEDURE ' m.cProcedure = substr(m.cLine, 11) do case case m.cProcedure == 'ActiveCell' m.cUpdatedMethods = m.cUpdatedMethods + ; 'PROCEDURE ActivateCell' + c_crlf otherwise m.cUpdatedMethods = m.cUpdatedMethods + m.cLine + c_crlf endcase else m.cUpdatedMethods = m.cUpdatedMethods + m.cLine + c_crlf endif endfor * strip off extra crlf if right(m.cUpdatedMethods,4) = c_crlf + c_crlf m.cUpdatedMethods = ; left(m.cUpdatedMethods, len(m.cUpdatedMethods) - len(c_crlf)) endif replace methods with m.cUpdatedMethods endscan m.iVersion = .027 =UpdateVersion('VERSION = 0.027') case m.iVersion = .027 .and. OkToBuild(344) m.cExact = set('exact') set exact on *** Version .028 Modifications *** scan for !empty(baseclass) m.cUpdatedProperties = '' _mline=0 for m.i = 1 to memlines(properties) m.cLine = mline(properties, 1, _mline) if empty(m.cLine) loop endif m.cProperty = alltrim(left(m.cLine, at('=', m.cLine) - 1)) m.cJustProperty = iif('.' $ m.cProperty, ; substr(m.cProperty, rat('.', m.cProperty) + 1), ; m.cProperty) m.cValue = alltrim(substr(m.cLine, at('=', m.cLine) + 1)) do case * Form Changes * Delete method dropped * PrintForm method dropped case inlist(m.cJustProperty, 'AutoRedraw', 'RecordSelector', ; 'RecordLocks', 'GoFirst', 'GoLast', 'Skip', 'SkipForm', 'Window') * The AutoRedraw, RecordSelector, RecordLocks, and * Window properties are dropped. * The GoFirst, GoLast, Skip, and SkipForm properties are hidden * and shouldn't appear in the form/class. loop * Cursor Changes * FilterCondition (Property or Method?) dropped * Add NoDataOnLoad property case m.cJustProperty = 'FilterCondition' && in case it's a property loop case m.cJustProperty = 'Updateable' * Rename to ReadOnly and reverse value if m.cValue = '.F.' m.cValue = '.T.' else m.cValue = '.F.' endif m.cUpdatedProperties = m.cUpdatedProperties + ; left(m.cProperty, rat('Updateable', m.cProperty) - 1) + ; 'ReadOnly = ' + m.cValue + c_crlf * Data Environment Changes * Add DEUnload event case m.cJustProperty = 'AutoLoadEnv' * Rename to AutoOpenTables m.cUpdatedProperties = m.cUpdatedProperties + ; left(m.cProperty, rat('AutoLoadEnv', m.cProperty) - 1) + ; 'AutoOpenTables = ' + m.cValue + c_crlf case m.cJustProperty = 'AutoUnloadEnv' * Rename to AutoCloseTables m.cUpdatedProperties = m.cUpdatedProperties + ; left(m.cProperty, rat('AutoUnloadEnv', m.cProperty) - 1) + ; 'AutoCloseTables = ' + m.cValue + c_crlf * Relation Changes * Add OneToMany property case m.cJustProperty = 'ChildIndexTag' * Rename to ChildOrder m.cUpdatedProperties = m.cUpdatedProperties + ; left(m.cProperty, rat('ChildIndexTag', m.cProperty) - 1) + ; 'ChildOrder = ' + m.cValue + c_crlf case m.cJustProperty = 'ParentIndexExpr' * Rename to RelationalExpr m.cUpdatedProperties = m.cUpdatedProperties + ; left(m.cProperty, rat('ParentIndexExpr', m.cProperty) - 1) + ; 'RelationalExpr = ' + m.cValue + c_crlf * Spinner Changes * Clear method dropped * Shape Changes * Add FillColor property * Add BackColor property * Add Enabled property * Grid Changes * Add AfterRowColChange(cColName) method * Add DynamicFontOutline, DynamicFontShadow, DynamicFontStrikethru, * DynamicFontUnderline, and ReadOnly properties * Add DynamicFontBold and DynamicFontItalic properties case m.cJustProperty = 'Relation' * Rename to RelationalExpr m.cUpdatedProperties = m.cUpdatedProperties + ; left(m.cProperty, rat('Relation', m.cProperty) - 1) + ; 'RelationalExpr = ' + m.cValue + c_crlf case m.cJustProperty = 'DynamicFontStyle' * Dropped loop * Column Changes * Add ColumnOrder, DynamicFontOutline, DynamicFontShadow, * DynamicFontStrikethru, and DynamicFontUnderline properties * Textbox Changes * Add PasswordChar and Style properties * Image Changes * Add Enabled property case m.cJustProperty = 'Stretch' * Changing from logical to numeric. Actually changed prior to build 343, * so leave alone if it's not a logical. do case case m.cValue = '.T.' m.cValue = '2' case m.cValue = '.F.' m.cValue = '0' endcase m.cUpdatedProperties = m.cUpdatedProperties + ; m.cProperty + ' = ' + m.cValue + c_crlf * Line Changes * Add Enabled property case m.cJustProperty = 'ForeColor' .and. baseclass = 'line' * Rename to BorderColor. Since we're doing this only for * line controls, subclassed lines may get broken. m.cUpdatedProperties = m.cUpdatedProperties + ; left(m.cProperty, rat('ForeColor', m.cProperty) - 1) + ; 'BorderColor = ' + m.cValue + c_crlf case m.cJustProperty = 'LineSlant' * Change from numeric to character if m.cValue = '0' m.cValue = '"/"' else m.cValue = '"\"' endif m.cUpdatedProperties = m.cUpdatedProperties + ; m.cProperty + ' = ' + m.cValue + c_crlf * Label Changes * Add Enabled property * Pageframe Changes case m.cJustProperty = 'TabWidth' * Dropped loop otherwise m.cUpdatedProperties = m.cUpdatedProperties + m.cLine + c_crlf endcase endfor replace properties with m.cUpdatedProperties m.cUpdatedMethods = '' _mline=0 for m.i = 1 to memlines(methods) m.cLine = mline(methods, 1, _mline) if empty(m.cLine) .or. upper(left(m.cLine, 10)) <> 'PROCEDURE ' * Maintain blank lines in code m.cUpdatedMethods = m.cUpdatedMethods + m.cLine + c_crlf loop endif m.cMethod = alltrim(substr(m.cLine, at(' ', m.cLine) + 1)) m.cJustMethod = iif('.' $ m.cMethod, ; substr(m.cMethod, rat('.', m.cMethod) + 1), ; m.cMethod) do case * Column Changes case m.cJustMethod = 'Move' .and. baseclass = 'grid' * Rename to Moved--since we're renaming just the grid control, * there will be some errors in subclassed controls. m.cUpdatedMethods = m.cUpdatedMethods + 'PROCEDURE ' + ; left(m.cMethod, rat('Move', m.cMethod) - 1) + ; 'Moved' + c_crlf * Grid Changes case m.cJustMethod = 'RowColChange' * Rename to BeforeRowColChange and add required * Parameters nColIndex statement m.cUpdatedMethods = m.cUpdatedMethods + 'PROCEDURE ' + ; left(m.cMethod, rat('RowColChange', m.cMethod) - 1) + ; 'BeforeRowColChange' + c_crlf + ; 'Parameters nColIndex' + c_crlf case m.cJustMethod = 'Deleted' * Now requires nRecNo parameter m.cUpdatedMethods = m.cUpdatedMethods + ; m.cLine + c_crlf + 'Parameters nRecNo' + c_crlf * DataEnvironment Changes case m.cJustMethod = 'AfterAllTablesOpened' * Rename to DELoad m.cUpdatedMethods = m.cUpdatedMethods + 'PROCEDURE ' + ; left(m.cMethod, rat('AfterAllTablesOpened', m.cMethod) - 1) + ; 'DELoad' + c_crlf case m.cJustMethod = 'LoadEnv' * Rename to LoadDE m.cUpdatedMethods = m.cUpdatedMethods + 'PROCEDURE ' + ; left(m.cMethod, rat('LoadEnv', m.cMethod) - 1) + ; 'LoadDE' + c_crlf case m.cJustMethod = 'UnloadEnv' * Rename to UnloadDE m.cUpdatedMethods = m.cUpdatedMethods + 'PROCEDURE ' + ; left(m.cMethod, rat('UnloadEnv', m.cMethod) - 1) + ; 'UnloadDE' + c_crlf otherwise m.cUpdatedMethods = m.cUpdatedMethods + m.cLine + c_crlf endcase endfor * strip off extra crlf if right(m.cUpdatedMethods,4) = c_crlf + c_crlf m.cUpdatedMethods = ; left(m.cUpdatedMethods, len(m.cUpdatedMethods) - len(c_crlf)) endif replace methods with m.cUpdatedMethods endscan set exact &cExact m.iVersion = .028 =UpdateVersion('VERSION = 0.028') * Insert next update here otherwise exit endcase enddo if m.lSuccess copy to (m.cScxName) for !deleted() use in ScxFile2 if m.iVersion >= .019 && drop columns declares and declares2 use (m.cScxName) if type('declares') = 'M' alter table (m.cScxName) drop column declares endif if type('declares2') = 'M' alter table (m.cScxName) drop column declares2 endif use endif m.cOnError=on('error') m.iError=0 on error m.iError=error() compile form (m.cScxName) on error &cOnError if !empty(m.iError) =Alert('Error #'+alltrim(str(m.iError))+' occurred '+ ; 'compiling '+m.cScxName+'.') endif else use in ScxFile2 endif if m.lNotify activate screen if m.lSuccess ??'Complete.' else ??'Skipped.' endif endif endif ********************* procedure GetProperty ********************* * This procedure accepts a properties memo field string and the name a property. It * returns the value of the property if it's found, or an empty string if it's not found. parameters m.cProperties, m.cPropertyName local i, cLine _mline = 0 for m.i = 1 to memlines(m.cProperties) m.cLine = mline(m.cProperties, 1, _mline) if alltrim(left(m.cLine, at('=', m.cLine) - 1)) == m.cPropertyName return alltrim(substr(m.cLine, at('=', m.cLine) + 1)) endif endfor return '' ********************* procedure PutProperty ********************* * This procedure accepts a properties memo field string, the name of a property, and the * string containing the value to which the property should be set. It returns the properties * memo field string which reflects the new property value. parameters m.cProperties, m.cPropertyName, m.cNewValue local i, cLine, cUpdatedProperties, cProperty _mline = 0 m.cUpdatedProperties = '' for m.i = 1 to memlines(m.cProperties) m.cLine = mline(m.cProperties, 1, _mline) if empty(m.cLine) loop endif if alltrim(left(m.cLine, at('=', m.cLine) - 1)) == m.cPropertyName m.cUpdatedProperties = m.cUpdatedProperties + m.cPropertyName + ' = ' + m.cNewValue + c_crlf else m.cUpdatedProperties = m.cUpdatedProperties + m.cLine + c_crlf endif endfor return m.cUpdatedProperties *********************** procedure UpdateVersion *********************** parameters m.cVersionString go top if !platform='COMMENT' =ScxUpdtrError(-1,m_NotComment) endif replace reserved1 with m.cVersionString ******************* procedure UpdateDbc ******************* parameters m.cDbcName, m.lNotify private m.cError, m.lError, m.cOnError if .not. file(forceext(m.cDbcName,'dbf')) .and. ; .not. file(forceext(m.cDbcName,'dct')) .and. ; file(forceext(m.cDbcName,'fpt')) rename (forceext(m.cDbcName,'fpt')) to (forceext(m.cDbcName,'dct')) erase (forceext(m.cDbcName,'cdx')) m.cOnError=on('error') on error * use (m.cDbcName) on error &cOnError endif use (m.cDbcName) alias dbcfile m.lIsDbc=.f. do case case type('objectid')<>'N' case type('parentid')<>'N' case type('objecttype')<>'C' case type('objectname')<>'C' case type('property')<>'M' otherwise m.lIsDbc=.t. endcase if !m.lIsDbc =Alert(m.cDbcName+m_Not30Dbc) use return endif if m.lNotify activate screen ?'Updating '+m.cDbcName+'... ' endif m.iBuildNo=val(substr(version(1),24,4)) m.iVersion=sys(4001) do while .t. do case case m.iVersion<4 if m.iVersion=1 use alter table (m.cDbcName) ; alter column objectname c(128) not null use (m.cDbcName) alias dbcfile endif =sys(4000) use open database (m.cDbcName) close database use (m.cDBCName) alias dbcfile m.iVersion=4 case m.iVersion = 4 if m.iBuildNo<226 .and. OkToBuild(226) =Alert("DBC files cannot be updated beyond the build you're currently using.") exit endif && delete all entries from .DBC except those of type System, Table, Column, && Index, or Relation use (m.cDbcName) alias dbcfile m.cExact=set('exact') set exact on delete for !inlist(alltrim(objecttype),'System','Table','Column','Index','Relation') set exact &cExact pack if !type('dbcfile.code')='M' alter table dbcfile add column code m calculate max(objectid) to m.iMaxObjId insert into (m.cDbcName) (objectid, parentid, objecttype, objectname) ; values (m.iMaxObjId+1, 1, 'System', 'StoredProceduresSource') insert into (m.cDbcName) (objectid, parentid, objecttype, objectname) ; values (m.iMaxObjId+2, 1, 'System', 'StoredProceduresObject') endif m.iVersion=5 case m.iVersion = 5 if m.iBuildNo < 248 .and. OkToBuild(248) =Alert("DBC files cannot be updated beyond the build you're currently using.") exit endif replace objecttype with 'Database' for objecttype = 'System' reindex m.iVersion = 6 case m.iVersion = 6 if m.iBuildNo < 270 .and. OKToBuild(270) =Alert("DBC files cannot be updated beyond the build you're currently using.") exit endif * Rename objecttype "Column" to "Field" and add User memo field * Build 269 creates objecttype "Field" objects, but doesn't * add User memo field. replace objecttype with 'Field' for objecttype = 'Column' alter table (dbf()) add column user m reindex m.iVersion = 7 case m.iVersion = 7 * Modification to how relations are stored if m.iBuildNo < 275 .and. OKToBuild(275) =Alert("DBC files cannot be updated beyond the build you're currently using.") exit endif scan for objecttype = 'Relation' =sys(4010) endscan m.iVersion = 8 case m.iVersion = 8 if m.iBuildNo < 336 .and. OKToBuild(336) =Alert("DBC files cannot be updated beyond the build you're currently using.") exit endif copy to _xxxtemp.dbc zap alter table (dbf()) drop column user alter table (dbf()) add column riinfo c(6) alter table (dbf()) add column user m append from _xxxtemp.dbc use _xxxtemp.dbc in 0 set relation to recno() into _xxxtemp delete ALL for deleted('_xxxtemp') use in _xxxtemp erase _xxxtemp.dbc erase _xxxtemp.dct erase _xxxtemp.dcx m.iVersion = 9 * Insert next update here otherwise && stamp the file current use (m.cDbcName) alias dbcfile =sys(4000) use exit endcase enddo if m.lNotify activate screen ??'Complete.' endif *********************** procedure ScxUpdtrSetup *********************** parameters m.lCleanup if empty(m.lCleanup) dimension aEnvironment[20] if set('talk')='ON' set talk off aEnvironment[1]='ON' else aEnvironment[1]='OFF' endif aEnvironment[2]=on('error') on error do ScxUpdtrError with error(), message() push key clear erase '26759970.vue' create view 26759970.vue close all aEnvironment[4]=set('safety') set safety off aEnvironment[5]=set('exact') set exact off aEnvironment[6]=_mline aEnvironment[7]=set('memowidth') set memowidth to 256 aEnvironment[8]=set('notify') set notify off aEnvironment[3]=sys(5)+curdir() aEnvironment[9] = set('exclusive') set exclusive on else set exclusive &aEnvironment[9] set notify &aEnvironment[8] set memowidth to (aEnvironment[7]) _mline=aEnvironment[6] set exact &aEnvironment[5] set safety &aEnvironment[4] set talk &aEnvironment[1] pop key set default to (aEnvironment[3]) close all set view to 26759970.vue erase 26759970.vue on error &aEnvironment[2] endif ******************* procedure UpdateAll ******************* private iBuildID m.iBuildID=val(substr(version(1),24,4)) if m.iBuildID < FOXPRO_BUILD_ID if Alert('You are running Build '+str(m.iBuildID,3)+ ; ' and 30Update is prepared to update to Build '+ ; str(FOXPRO_BUILD_ID,3)+'. Do you want to update to '+ ; 'Build '+str(FOXPRO_BUILD_ID,3)+'? (If you answer '+ ; 'No, files will be updated to Build '+str(m.iBuildID,3)+'.)', ; MB_ICONEXCLAMATION+MB_YESNO) = 'NO' return .f. endif endif ******************* procedure OkToBuild ******************* parameters m.iBuildNo private m.iBuildID m.iBuildID=val(substr(version(1),24,4)) do case case m.iBuildNo > FOXPRO_BUILD_ID return .f. case m.iBuildID < m.iBuildNo return m.lUpdateAll otherwise return .t. endcase ********************** procedure ScxUpdtrMain ********************** private m.lUpdateAll m.lUpdateAll=UpdateAll() if empty(m.cScxName) frmScxUpdtr=createobj('ScxUpdater') frmScxUpdtr.show read events release frmScxUpdtr else do case case type('m.cScxName')<>'C' =ScxUpdtrError(-1,e_InvalidParameter) case !file(m.cScxName) =ScxUpdtrError(-1,m.cScxName+e_ScxNotFound) otherwise do UpdateScx with m.cScxName endcase endif ************************* procedure ScxUpdtrCleanup ************************* do ScxUpdtrSetup with 'CLEANUP' ********************** procedure ScxUpdtrError ********************** parameters m.iError, m.cMessage, m.cAction if c_debug m.cAction=Alert(m.cMessage,MB_ICONEXCLAMATION+MB_ABORTRETRYIGNORE, ; m_MsgBoxTitle) do case case m.cAction='RETRY' set step on retry case m.cAction='IGNORE' return endcase else =Alert(m.cMessage,MB_ICONEXCLAMATION+MB_OK,m_MsgBoxTitle) endif if type('m.iPrgHandle')='N' =fclose(m.iPrgHandle) endif if type('m.cTmpFil')='C' erase (m.cTmpFil) endif release frmScxUpdtr return to ScxUpdtr ******************** procedure Alert ******************** parameters m.cMessage, m.cOptions, m.cTitle private m.cTalk, m.cOptions, m.cResponse if set('talk')='ON' set talk off m.cTalk='ON' else m.cTalk='OFF' endif m.cOptions=iif(empty(m.cOptions),0,m.cOptions) if !empty(m.cTitle) m.cResponse=MessageBox(m.cMessage,m.cOptions, m.cTitle) else m.cResponse=MessageBox(m.cMessage,m.cOptions) endif do case case m.cResponse=1 m.cResponse='OK' case m.cResponse=6 m.cResponse='YES' case m.cResponse=7 m.cResponse='NO' case m.cResponse=2 m.cResponse='CANCEL' case m.cResponse=3 m.cResponse='ABORT' case m.cResponse=4 m.cResponse='RETRY' case m.cResponse=5 m.cResponse='IGNORE' endcase set talk &cTalk return m.cResponse ******************** procedure DirTree ******************** parameters m.cDirName, m.aDirTree private m.aTemp, m.cTalk, m.i if set('talk')='ON' set talk off m.cTalk='ON' else m.cTalk='OFF' endif dimension aDirTree[1,max(1,alen(aDirTree,2))] aDirTree[1,1]=addbs(m.cDirName) m.i=0 do while m.i<alen(aDirTree,1) m.i=m.i+1 if !empty(adir(aTemp,aDirTree[m.i,1]+'*.*','D')) for m.j=1 to alen(aTemp,1) if !'D'$aTemp[m.j,5] .or. inlist(aTemp[m.j,1],'.','..') loop endif dimension aDirTree[alen(aDirTree,1)+1,alen(aDirTree,2)] aDirTree[alen(aDirTree,1),1]=addbs(aDirTree[m.i,1]+aTemp[m.j,1]) endfor endif enddo =asort(aDirTree) if m.cTalk='ON' set talk on endif endproc ******************** procedure AddBS ******************** * Adds a backslash character to the string. * Called before FoxTools is loaded. parameters m.wzsString if right(alltrim(m.wzsString),1)='\' return alltrim(m.wzsString) else return alltrim(m.wzsString)+'\' endif endproc ******************** procedure ascanner ******************** * This procedure returns the element number (not the row number) * of the first match, verified to be in column m.column PARAMETERS m.thearray, m.expression, m.column, m.start, m.howmany, ; m.wzlReturnRow m.start=IIF(EMPTY(m.start),1,m.start) m.element=IIF(TYPE('m.start')='N',m.start-1,0) m.column=IIF(EMPTY(m.column),1,m.column) m.howmany=IIF(EMPTY(m.howmany),ALEN(thearray),m.howmany) DO WHILE .T. m.element=ASCAN(thearray,expression,m.element+1,m.howmany) IF m.element=0 .OR. ASUBSCRIPT(thearray,m.element,2)=m.column EXIT ELSE m.howmany=m.howmany-m.element-1 m.howmany=max(m.howmany,1) ENDIF ENDDO if m.wzlReturnRow if !empty(m.element) m.element=asubscript(thearray,m.element,1) endif endif RETURN m.element ******************** procedure Setting ******************** parameters m.cMemo, m.cSetting private m.i_mline, m.cLine, m.cReturn m.i_mline=_mline _mline=0 m.cReturn='' for m.i=1 to memlines(m.cMemo) m.cLine=mline(m.cMemo,1,_mline) if upper(alltrim(left(m.cLine,at('=',m.cLine)-1)))== ; upper(alltrim(m.cSetting)) m.cReturn=ltrim(substr(m.cLine,at('=',m.cLine)+1)) exit endif endfor _mline=m.i_mline return m.cReturn *!***************************************************************************** *! *! Function: FORCEEXT *! *! Calls: JUSTPATH() (function in GENSCRN.PRG) *! : JUSTFNAME() (function in GENSCRN.PRG) *! : ADDBS() (function in GENSCRN.PRG) *! *!***************************************************************************** FUNCTION forceext *) *) FORCEEXT - Force filename to have a particular extension. *) PARAMETERS m.filname,m.ext PRIVATE m.ext IF SUBSTR(m.ext,1,1) = "." m.ext = SUBSTR(m.ext,2,3) ENDIF m.pname = justpath(m.filname) m.filname = justfname(UPPER(ALLTRIM(m.filname))) IF AT('.',m.filname) > 0 m.filname = SUBSTR(m.filname,1,AT('.',m.filname)-1) + '.' + m.ext ELSE m.filname = m.filname + '.' + m.ext ENDIF RETURN addbs(m.pname) + m.filname *!***************************************************************************** *! *! Function: JUSTPATH *! *! Called by: FORCEEXT() (function in GENSCRN.PRG) *! *!***************************************************************************** FUNCTION justpath *) *) JUSTPATH - Returns just the pathname. *) PARAMETERS m.filname m.filname = ALLTRIM(UPPER(m.filname)) IF '\' $ m.filname m.filname = SUBSTR(m.filname,1,RAT('\',m.filname)) IF RIGHT(m.filname,1) = '\' AND LEN(m.filname) > 1 ; AND SUBSTR(m.filname,LEN(m.filname)-1,1) <> ':' filname = SUBSTR(m.filname,1,LEN(m.filname)-1) ENDIF RETURN m.filname ELSE RETURN '' ENDIF *!***************************************************************************** *! *! Function: JUSTFNAME *! *! Called by: FORCEEXT() (function in GENSCRN.PRG) *! *!***************************************************************************** FUNCTION justfname *) *) JUSTFNAME - Return just the filename (i.e., no path) from "filname" *) PARAMETERS m.filname IF RAT('\',m.filname) > 0 m.filname = SUBSTR(m.filname,RAT('\',m.filname)+1,255) ENDIF IF AT(':',m.filname) > 0 m.filname = SUBSTR(m.filname,AT(':',m.filname)+1,255) ENDIF RETURN ALLTRIM(UPPER(m.filname)) *!***************************************************************************** *! *! Function: JUSTEXT *! *!***************************************************************************** FUNCTION justext * Return just the extension from "filname" PARAMETERS m.filname PRIVATE m.ext filname = justfname(m.filname) && prevents problems with ..\ paths m.ext = "" IF AT('.',m.filname) > 0 m.ext = SUBSTR(m.filname,AT('.',m.filname)+1,3) ENDIF RETURN UPPER(m.ext) ******************** procedure FileType ******************** parameters m.cFileName private m.cOnError, m.iError, m.iSelect, m.cFileType m.iSelect=select() select 0 m.cOnError=on('error') on error m.iError=error() use (m.cFileName) on error &cOnError if type('m.iError')='N' .and. m.iError=41 && memo file missing or invalid if justext(m.cFileName)='DBC' if .not. file(forceext(m.cFileName,'dbf')) .and. ; .not. file(forceext(m.cFileName,'dct')) .and. ; file(forceext(m.cFileName,'fpt')) rename (forceext(m.cFileName,'fpt')) to (forceext(m.cFileName,'dct')) erase (forceext(m.cFileName,'cdx')) m.cOnError=on('error') on error m.iError=error() use (m.cFileName) on error &cOnError if empty(dbf()) rename (forceext(m.cFileName,'dct')) to (forceext(m.cFileName,'fpt')) else erase (forceext(m.cFileName,'cdx')) endif endif endif endif if !empty(dbf()) do case case type('platform')='C' .and. ; type('uniqueid ')='C' .and. ; type('timestamp')='N' .and. ; type('reserved1')='M' .and. ; type('reserved2')='M' .and. ; type('reserved3')='M' .and. ; type('user')='M' .and. ; type('comment')='M' .and. ; (type('class')='C' .or. type('class')='M') .and. ; type('classloc')='M' .and. ; type('objname')='M' .and. ; type('parent')='M' .and. ; type('properties')='M' .and. ; type('methods')='M' .and. ; type('objcode')='M' m.cFileType='SCX' * could be VCX, but doesn't matter right now case type('objectid')='N' .and. ; type('parentid')='N' .and. ; type('objecttype')='C' .and. ; type('objectname')='C' .and. ; type('property')='M' m.cFileType='DBC' case type('name') = 'M' .and. ; type('type') = 'C' .and. ; type('timestamp') = 'N' .and. ; type('outfile') = 'M' .and. ; type('homedir') = 'M' .and. ; type('exclude') = 'L' .and. ; type('mainprog') = 'L' .and. ; type('savecode') = 'L' .and. ; type('debug') = 'L' .and. ; type('encrypt') = 'L' .and. ; type('nologo') = 'L' .and. ; type('cmntstyle') = 'N' .and. ; type('objrev') = 'N' .and. ; type('commands') = 'M' .and. ; type('devinfo') = 'M' .and. ; type('symbols') = 'M' .and. ; type('object') = 'M' .and. ; type('ckval') = 'N' .and. ; type('cpid') = 'N' .and. ; type('ostype') = 'C' .and. ; type('oscreator') = 'C' .and. ; type('comments') = 'M' .and. ; type('reserved1') = 'M' .and. ; type('reserved2') = 'M' m.cFileType = 'PJX' otherwise m.cFileType='UNKNOWN' endcase use else m.cFileType='UNKNOWN' endif select (m.iSelect) return m.cFileType ******************************************************************************** ******************************* CLASS DEFINTIONS ******************************* ******************************************************************************** define class ScxUpdater as form Backcolor = rgb(192,192,192) ScaleMode = 3 Height = 325 Width = 445 Caption = 'FoxPro 3.0 Updater' AutoCenter = .t. add object txtHelp as editbox with ; Value = ; '30Update is a utility for updating .SCX, .VCX, .DBC, '+ ; 'and .PJX files to reflect changes made during the '+ ; 'development of FoxPro 3.0.'+ ; chr(13)+chr(13)+ ; '30Update does not make backup copies of the files it updates. '+ ; 'Make a backup of your files before using this utility.' + ; chr(13) + chr(13) + ; '30Update Revision #03.00.00.0' + alltrim(str(FOXPRO_BUILD_ID)), ; Height = 130, ; Left = 18, ; Top = 13, ; Width = 410, ; BorderStyle = 0, ; ReadOnly = .t., ; TabStop = .f., ; ScrollBars = 0, ; BackColor = rgb(192,192,192) add object cmdFile as commandbutton with ; Caption = 'File...', ; Height = 23, ; Left = 18, ; Top = 156, ; Width = 75 add object cmdDir as commandbutton with ; Caption = 'Directory...', ; Height = 23, ; Left = 18, ; Top = 188, ; Width = 75 add object chkSubdirs as checkbox with ; Caption = 'Include Subdirectories', ; Height = 16, ; Left = 105, ; Top = 219, ; Width = 160, ; Enabled = .f., ; BackStyle = 0 add object chkScxFiles as checkbox with ; Caption = '.SCX Files', ; Height = 16, ; Left = 288, ; Top = 219, ; Width = 85, ; Value = 1, ; Enabled = .f., ; BackStyle = 0 add object chkVcxFiles as checkbox with ; Caption = '.VCX Files', ; Height = 16, ; Left = 288, ; Top = 234, ; Width = 85, ; Value = 1, ; Enabled = .f., ; BackStyle = 0 add object chkDbcFiles as checkbox with ; Caption = '.DBC Files', ; Height = 16, ; Left = 288, ; Top = 249, ; Width = 85, ; Value = 1, ; Enabled = .f., ; BackStyle = 0 add object chkPjxFiles as checkbox with ; Caption = '.PJX Files', ; Height = 16, ; Left = 288, ; Top = 264, ; Width = 85, ; Value = 1, ; Enabled = .f., ; BackStyle = 0 add object lblFileName as label with ; Caption = '', ; Height = 15, ; Left = 104, ; Top = 160, ; Width = 320 * BugBug: BackColor = rgb(192,192,192) add object lblDirName as label with ; Caption = '', ; Height = 15, ; Left = 104, ; Top = 192, ; Width = 320 * BugBug: BackColor = rgb(192,192,192) add object cmdUpdate as commandbutton with ; Caption = 'Update', ; Default = .T., ; Enabled = .F., ; Height = 23, ; Left = 135, ; Top = 293, ; Width = 75 add object cmdCancel as commandbutton with ; Caption = 'Exit', ; Height = 23, ; Left = 224, ; Top = 293, ; Width = 75 procedure cmdFile.Click thisform.lblFileName.Caption=getfile('scx;vcx;dbc;pjx', ; 'Select file to update:') if !empty(thisform.lblFileName.Caption) thisform.lblDirName.Caption='' endif thisform.Refresh endproc procedure cmdDir.Click thisform.lblDirName.Caption=getdir('', ; 'Select directory to update:') if !empty(thisform.lblDirName.Caption) thisform.lblFileName.Caption='' endif thisform.Refresh endproc procedure chkScxFiles.Click thisform.Refresh endproc procedure chkVcxFiles.Click thisform.Refresh endproc procedure chkDbcFiles.Click thisform.Refresh endproc procedure chkPjxFiles.Click thisform.Refresh endproc procedure Destroy clear events endproc procedure Init * this.txtHelp.BackStyle = 0 && bug endproc procedure Refresh if !empty(this.lblDirName.Caption) this.chkSubdirs.Enabled=.t. this.chkScxFiles.Enabled=.t. this.chkVcxFiles.Enabled=.t. this.chkDbcFiles.Enabled=.t. this.chkPjxFiles.Enabled = .t. else this.chkSubdirs.Enabled=.f. this.chkScxFiles.Enabled=.f. this.chkVcxFiles.Enabled=.f. this.chkDbcFiles.Enabled=.f. this.chkPjxFiles.Enabled = .f. endif do case case !empty(this.lblFileName.Caption) this.cmdUpdate.Enabled=.t. case !empty(this.lblDirName.Caption) .and. ; (this.chkScxFiles.Value=1 .or. ; this.chkVcxFiles.Value=1 .or. ; this.chkDbcFiles.Value=1 .or. ; this.chkPjxFiles.Value = 1) this.cmdUpdate.Enabled=.t. otherwise this.cmdUpdate.Enabled=.f. endcase endproc procedure cmdUpdate.Click m.cResponse=Alert('30Update overwrites existing files. '+ ; 'You should make a backup before running this utility. '+ ; 'Do you want to continue?',MB_ICONEXCLAMATION+MB_YESNO) if m.cResponse='NO' return endif if !empty(thisform.lblFileName.Caption) * do UpdateScx with thisform.lblFileName.Caption, .t. * This is a workaround--the preceding call doesn't properly pass the parameter. private m.cFileName m.cFileName=thisform.lblFileName.Caption m.cFileType=FileType(m.cFileName) do case case inlist(m.cFileType,'SCX','VCX') do UpdateScx with m.cFileName, .t. case m.cFileType='DBC' do UpdateDbc with m.cFileName, .t. case m.cFileType = 'PJX' do UpdatePJX with m.cFileName, .t. otherwise =Alert(m.cFileName+' is not a SCX, VCX, DBC, or PJX file.') endcase thisform.lblFileName.Caption='' thisform.Refresh else * Same workaround here, also. private m.aDirs, m.cDirName, m.i, m.aScxFiles dimension aDirs[1,1] if thisform.chkSubDirs.value=1 m.cDirName=thisform.lblDirName.Caption do dirtree with cDirName, aDirs else aDirs[1,1]=thisform.lblDirName.Caption endif do while !empty(aDirs[1,1]) if thisform.chkVcxFiles.Value=1 if !empty(adir(aScxFiles,addbs(aDirs[1,1])+'*.Vcx')) =asort(aScxFiles) for m.i=1 to alen(aScxFiles,1) do UpdateScx with addbs(aDirs[1,1])+aScxFiles[m.i,1], .t. endfor endif endif if thisform.chkScxFiles.Value=1 if !empty(adir(aScxFiles,addbs(aDirs[1,1])+'*.Scx')) =asort(aScxFiles) for m.i=1 to alen(aScxFiles,1) do UpdateScx with addbs(aDirs[1,1])+aScxFiles[m.i,1], .t. endfor endif endif if thisform.chkDbcFiles.Value=1 if !empty(adir(aScxFiles,addbs(aDirs[1,1])+'*.dbc')) =asort(aScxFiles) for m.i=1 to alen(aScxFiles,1) do UpdateDbc with addbs(aDirs[1,1])+aScxFiles[m.i,1], .t. endfor endif endif if thisform.chkPjxFiles.Value = 1 if !empty(adir(aScxFiles,addbs(aDirs[1,1])+'*.pjx')) =asort(aScxFiles) for m.i=1 to alen(aScxFiles,1) do UpdatePjx with addbs(aDirs[1,1])+aScxFiles[m.i,1], .t. endfor endif endif =adel(aDirs,1) enddo thisform.lblDirName.Caption='' thisform.Refresh endif endproc procedure cmdCancel.Click clear events endproc enddefine