* Program..: Utilities.prg * Author...: Jeremy Suiter * Date.....: 19/03/2003 * * Notice...: Copyright (c) 2003, Jeremy Suiter, All Rights Reserved * Notes....: Visual DbEditor General functions #Include "Font.ch" #Include "Gra.ch" #Include "Xbp.ch" #Include "Appevent.ch" #Include "Common.ch" #Include "Dmlb.ch" #Include "Dbstruct.ch" #Include "Inkey.ch" #Include "DbEditor.ch" #Include "Resources.ch" Static xBuffer:=Nil ************** Func CenterPos(aSize,aRefSize) ************** Return {Int((aRefSize[1] - aSize[1])/2), Int((aRefSize[2]-aSize[2])/2)} ************ Func Default(x,xval) ************ * Defaults variable x (passed by reference) to xval. Use as Default(@x,xval). If x=Nil x:=xval EndIf Return Nil ********* Func Errm(cMessage, cTitle, nIcon) ********* * error message box Local oFocus:=SetAppFocus() if nIcon == NIL nIcon := XBPMB_WARNING endif ConfirmBox(SetAppWindow(), cMessage, Iif(cTitle=Nil,"Error!",cTitle), XBPMB_OK , nIcon+XBPMB_APPMODAL+XBPMB_MOVEABLE) SetAppFocus(oFocus) Return Nil ********** Func Ntrim(nVal) ********** * Handy VO function Return Ltrim(Str(nVal)) *************** Proc MenuCreate(oDlg, oMenuBar) *************** Local oMenu, oSubMenu Begin Sequence oDlg:setDisplayFocus:={|mp1,mp2,obj| SetAppWindow(obj) } // First sub-menu oMenu:=SubMenuNew(oMenuBar, MENU_FILE) oMenu:setName(ID_UTILS_FILE) oMenu:addItem({ MENU_NEW, {|| Structure(.T.) }}) oMenu:addItem({ MENU_OPEN, {|| OpenFile(oDlg) }}) oMenu:addItem(MENUITEM_SEPARATOR) oMenu:addItem({ MENU_OPTIONS , {|| IIf(oFocusBrowse==Nil,SetOptions(),Nil) }}) oMenu:addItem({ MENU_PRINTER , {|| SetupPrinter() }}) oMenu:addItem(MENUITEM_SEPARATOR) oMenu:addItem({ MENU_EXIT , {|| PostAppEvent(xbeP_Close,,, oDlg) }}) oMenuBar:addItem({oMenu, Nil}) oMenu:=SubMenuNew(oMenuBar, MENU_UTILITIES) oMenu:setName(ID_UTILS_MENU) oMenu:addItem({ MENU_CUT , {|| CutField() }}) oMenu:addItem({ MENU_COPY , {|| CopyField() }}) oMenu:addItem({ MENU_PASTE , {|| PasteField() }}) oMenu:addItem(MENUITEM_SEPARATOR) oSubMenu:=SubMenuNew(oMenuBar, MENU_FIND) oSubMenu:addItem({ MENU_SCOPE , {|| SetScope() }}) oSubMenu:addItem({ MENU_GOTO , {|| GotoRecord() }}) oSubMenu:addItem({ MENU_SEEK , {|| SeekRecord() }}) oSubMenu:addItem({ MENU_LOCATE , {|| LocateRecords() }}) oMenu:addItem({oSubMenu, Nil}) oMenu:addItem(MENUITEM_SEPARATOR) oSubMenu:=SubMenuNew(oMenuBar, MENU_RECORDS) oSubMenu:addItem({ MENU_INSERT , {|| InsertRec() }}) oSubMenu:addItem({ MENU_DUPLICATE , {|| DupRecord() }}) oSubMenu:addItem({ MENU_DELETE , {|| DelRecord() }}) oSubMenu:addItem({ MENU_RECALL , {|| RestRecord() }}) oMenu:addItem({oSubMenu, Nil}) oMenu:addItem(MENUITEM_SEPARATOR) oSubMenu:=SubMenuNew(oMenuBar, MENU_TABLE) oSubMenu:addItem({ MENU_INDEXES, {|| SetIndex() }}) oSubMenu:addItem({ MENU_STRUCTURE, {|| Structure(.F.) }}) oSubMenu:addItem(MENUITEM_SEPARATOR) oSubMenu:addItem({ MENU_RELATIONS , {|| SetRelations() }}) oSubMenu:addItem({ MENU_MATHFUNC , {|| MathFunc() }}) oSubMenu:addItem(MENUITEM_SEPARATOR) oSubMenu:addItem({ MENU_IMPORT , {|| ImportData() }}) oSubMenu:addItem({ MENU_EXPORT , {|| ExportData() }}) oSubMenu:addItem(MENUITEM_SEPARATOR) oSubMenu:addItem({ MENU_PACK , {|| PackZapTable(.T.) }}) oSubMenu:addItem({ MENU_ZAP , {|| PackZapTable(.F.) }}) oMenu:addItem({oSubMenu, Nil}) oMenu:addItem(MENUITEM_SEPARATOR) oSubMenu:=SubMenuNew(oMenuBar, MENU_BULK) oSubMenu:addItem({ MENU_BULKREP , {|| BulkReplace() }}) oSubMenu:addItem({ MENU_BULKDEL , {|| BulkDeleteRecall(.T.) }}) oSubMenu:addItem({ MENU_BULKREC , {|| BulkDeleteRecall(.F.) }}) oMenu:addItem({oSubMenu, Nil}) oMenu:addItem(MENUITEM_SEPARATOR) oSubMenu:=SubMenuNew(oMenuBar, MENU_COLUMNS) oSubMenu:addItem({ MENU_FREEZE , {|| FreezeCol() }}) oSubMenu:addItem({ MENU_UNFREEZE , {|| DefrostCol() }}) oMenu:addItem({oSubMenu, Nil}) oMenu:addItem(MENUITEM_SEPARATOR) oMenu:addItem({ MENU_PREVIEW , {|| PreviewTable() }}) oMenu:disable() oMenuBar:addItem({oMenu, Nil}) oMenu:=SubMenuNew(oMenuBar, MENU_DATADICT) oMenu:setName(ID_DICT_MENU) oMenu:addItem({ MENU_DDMAINT , {|| DataDictionary() }}) oMenu:disable() oMenuBar:addItem({oMenu, Nil}) /* * Create an instance of the WindowMenu class for managing child windows */ oMenu:=WindowMenu():new(oMenuBar) oMenu:menuPos:=4 oMenu:create() // Help menu oMenu:=SubMenuNew(oMenuBar, MENU_HELP) oMenu:addItem({ MENU_SHOWHELP, {|| HelpObject():showHelpContents() } }) oMenuBar:addItem({oMenu, Nil}) End Return *************** Func SubMenuNew(oMenu,cTitle) *************** Local oSubMenu:=XbpMenu():new(oMenu) oSubMenu:title:=cTitle Return oSubMenu:create() *************** Func AddToolBar(oDlg) *************** * add toolbar items Local oXbp, x:=2 Begin Sequence oXbp:=XbpPushButton():new() oXbp:caption:=BITMAP_OPEN oXbp:create(oDlg:oToolBar, , {x,2}, {32,32}) oXbp:activate:={|| OpenFile(oDlg) } oXbp:helpLink:=MagicHelpLabel():New(TT_OPENTABLE) oXbp:setPointer(,POINTER_HAND) x+=34 oXbp:=XbpPushButton():new() oXbp:caption:=BITMAP_CLOSE oXbp:create(oDlg:oToolBar, , {x,2}, {32,32}) oXbp:activate:={|| CloseFile() } oXbp:helpLink:=MagicHelpLabel():New(TT_CLOSETABLE) oXbp:setPointer(,POINTER_HAND) x+=34 // separator oXbp:=XbpStatic():new(oDlg:oToolBar, , {x,2}, {4,32}) oXbp:type:=XBPSTATIC_TYPE_RECESSEDRECT oXbp:create() oXbp:setPointer(,POINTER_HAND) x+=6 oXbp:=XbpPushButton():new() oXbp:caption:=BITMAP_DELETE oXbp:create(oDlg:oToolBar, , {x,2}, {32,32}) oXbp:activate:={|| DelRecord() } oXbp:helpLink:=MagicHelpLabel():New(TT_DELETE) oXbp:setPointer(,POINTER_HAND) oXbp:setName(ID_DELETE_BTN) x+=34 oXbp:=XbpPushButton():new() oXbp:caption:=BITMAP_UNDELETE oXbp:create(oDlg:oToolBar, , {x,2}, {32,32}) oXbp:activate:={|| RestRecord() } oXbp:helpLink:=MagicHelpLabel():New(TT_RECALL) oXbp:setPointer(,POINTER_HAND) oXbp:setName(ID_UNDELETE_BTN) x+=34 oXbp:=XbpPushButton():new() oXbp:caption:=BITMAP_INDEX oXbp:create(oDlg:oToolBar, , {x,2}, {32,32}) oXbp:activate:={|| SetIndex() } oXbp:helpLink:=MagicHelpLabel():New(TT_INDEXOPT) oXbp:setPointer(,POINTER_HAND) oXbp:setName(ID_INDEX_BTN) x+=34 oXbp:=XbpPushButton():new() oXbp:caption:=BITMAP_OPTIONS oXbp:create(oDlg:oToolBar, , {x,2}, {32,32}) oXbp:activate:={|| SetScope() } oXbp:helpLink:=MagicHelpLabel():New(TT_SCOPE) oXbp:setPointer(,POINTER_HAND) oXbp:setName(ID_SCOPE_BTN) x+=34 oXbp:=XbpPushButton():new() oXbp:caption:=BITMAP_STRUCT oXbp:create(oDlg:oToolBar, , {x,2}, {32,32}) oXbp:activate:={|| Structure(.F.) } oXbp:helpLink:=MagicHelpLabel():New(TT_STRUCT) oXbp:setPointer(,POINTER_HAND) oXbp:setName(ID_STRUCTURE_BTN) x+=34 oXbp:=XbpPushButton():new() oXbp:caption:=BITMAP_REPORTS oXbp:create(oDlg:oToolBar, , {x,2}, {32,32}) oXbp:activate:={|| PreviewTable() } oXbp:helpLink:=MagicHelpLabel():New(TT_REPORTS) oXbp:setPointer(,POINTER_HAND) oXbp:setName(ID_REPORTS_BTN) x+=34 // separator oXbp:=XbpStatic():new(oDlg:oToolBar, , {x,2}, {4,32}) oXbp:type:=XBPSTATIC_TYPE_RECESSEDRECT oXbp:create() oXbp:setPointer(,POINTER_HAND) x+=6 oXbp:=XbpPushButton():new() oXbp:caption:=BITMAP_PRINTER oXbp:create(oDlg:oToolBar, , {x,2}, {32,32}) oXbp:activate:={|| SetupPrinter() } oXbp:helpLink:=MagicHelpLabel():New(TT_PRINTER) oXbp:setPointer(,POINTER_HAND) x+=34 oXbp:=XbpPushButton():new() oXbp:caption:=BITMAP_EXIT oXbp:create(oDlg:oToolBar, , {x,2}, {32,32}) // JWL 04/24/03 no appquit when closing main when compiled as function #IfDef DBEDFUNCTION oXbp:activate:={|x,y,obj| PostAppEvent(xbeP_Close,,, oDlg) } #else oXbp:activate:={|| AppQuit() } #endif oXbp:helpLink:=MagicHelpLabel():New(TT_EXIT) oXbp:setPointer(,POINTER_HAND) x+=34 oXbp:=XbpPushButton():new() oXbp:caption:=BITMAP_HELP oXbp:create(oDlg:oToolBar, , {x,2}, {32,32}) oXbp:activate:={|| HelpObject():showHelpContents() } oXbp:helpLink:=MagicHelpLabel():New(TT_HELP) oXbp:setPointer(,POINTER_HAND) End Return Nil ************* Func ReadFile(lMultiple) ************* Local oDlg:=Nil, aFiles:={}, oFocus:=SetAppFocus() Local aFilters:={ {"DBF Files", "*.DBF"}, ; {"CSV Files", "*.CSV"}, ; {"SDF Files", "*.SDF"}, ; {"TXT Files", "*.TXT"} } Default(@lMultiple,.T.) Begin Sequence oDlg:=XbpFileDialog():new() oDlg:fileFilters:=aFilters oDlg:center:=.T. oDlg:create() aFiles:=oDlg:open(cDirectory+"*."+cExtension,,lMultiple) //aFiles:=oDlg:open(cDirectory,,lMultiple) oDlg:destroy() SetAppFocus(oFocus) End Return aFiles ************* Func OpenFile(oDlg,cOpenFile) ************* Local lRetVal:=.F., oBrowseDialog, aFiles, cDefDbe:=cDbe, lExclusive:=!lMultiUser, lReadOnly:=.F., oController:=Nil Local nEvent, mp1:=Nil, mp2:=Nil Local oDbeDlg, oXbp, drawingArea, oGroup1, oDbe:=Nil, x, y, aDbe:={}, aPos:={}, aSize:={}, oFocus:=SetAppFocus(), oGroup2:=Nil, cAliasSLE:=Space(12) Local bSaveErrorBlock Local nAt Default(@cOpenFile,"") Begin Sequence If Empty(cOpenFile) aFiles:=ReadFile() If Empty(aFiles) SetAppFocus(oFocus) Break EndIf For x:=1 To Len(aFiles) aSize:={Max(340,StringLength(aFiles[x])),203} aPos:=CenterPos(aSize,AppDesktop():currentSize()) oDbeDlg:=XbpDialog():new(AppDesktop(), oDlg, aPos, aSize, , .F.) oDbeDlg:icon:=ICON_MAIN oDbeDlg:taskList:=.F. oDbeDlg:border:=XBPDLG_RAISEDBORDERTHIN_FIXED oDbeDlg:title:=aFiles[x] oDbeDlg:close:={|mp1,mp2,obj| PostAppEvent(xbeP_Close+1000) } oDbeDlg:create() oDbeDlg:setModalState(XBP_DISP_APPMODAL) oDbeDlg:keyBoard:={| nKeyCode, uNIL, self | Iif(nKeyCode==xbeK_ESC,PostAppEvent(xbeP_Close+1000),Nil) } drawingArea:=oDbeDlg:drawingArea drawingArea:setFontCompoundName("8.Helv") oGroup1:=XbpStatic():new(drawingArea, , {12,48}, {132,128}) oGroup1:caption:="Select DBE" oGroup1:clipSiblings:=.T. oGroup1:type:=XBPSTATIC_TYPE_GROUPBOX oGroup1:create() oDbe:=XbpCombobox():new(oGroup1, , {12,12}, {108,96}, { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD }, { XBP_PP_DISABLED_BGCLR, GRA_CLR_WHITE }}) oDbe:tabstop:=.T. oDbe:type:=XBPCOMBO_DROPDOWN oDbe:XbpSLE:editable:=.F. oDbe:setInputFocus:={| uNil1,uNil2,self | XbpBorder(self,GRA_CLR_BLUE) } oDbe:killInputFocus:={| uNil1,uNil2,self | XbpBorder(self, GRA_CLR_BACKGROUND) } oDbe:create() oDbe:XbpSLE:setData(cDefDbe) aDbe:=DbeList() ASort(aDbe,,, {|aX,aY| aX[1] < aY[1] }) For y:=1 To Len(aDbe) If aDbe[y,2]==.F. oDbe:addItem(aDbe[y,1]) EndIf Next oDbe:ItemSelected:={|mp1, mp2, obj| cDefDbe:=obj:XbpSLE:getData() } oGroup2:=XbpStatic():new(drawingArea, , {150,48}, {168,128}) oGroup2:caption:="Options" oGroup2:clipSiblings:=.T. oGroup2:type:=XBPSTATIC_TYPE_GROUPBOX oGroup2:create() oXbp:=XbpRadioButton():new(oGroup2, , {12,90}, {108,24}) oXbp:caption:="Shared" oXbp:tabStop:=.T. oXbp:selection:=!lExclusive oXbp:selected:={|| lExclusive:=IIf(lExclusive,.T.,.F.), lReadOnly:=.F. } oXbp:setInputFocus:={| uNil1,uNil2,self | XbpBorder(self,GRA_CLR_BLUE) } oXbp:killInputFocus:={| uNil1,uNil2,self | XbpBorder(self, GRA_CLR_BACKGROUND) } oXbp:create() oXbp:=XbpRadioButton():new(oGroup2, , {12,64}, {108,24}) oXbp:caption:="Exclusive" oXbp:tabStop:=.T. oXbp:selection:=lExclusive oXbp:selected:={|| lExclusive:=IIf(lExclusive,.F.,.T.), lReadOnly:=.F. } oXbp:setInputFocus:={| uNil1,uNil2,self | XbpBorder(self,GRA_CLR_BLUE) } oXbp:killInputFocus:={| uNil1,uNil2,self | XbpBorder(self, GRA_CLR_BACKGROUND) } oXbp:create() oXbp:=XbpRadioButton():new(oGroup2, , {12,38}, {108,24}) oXbp:caption:="Read Only" oXbp:tabStop:=.T. oXbp:selection:=lReadOnly oXbp:selected:={|| lReadOnly:=IIf(lReadOnly,.F.,.T.) } oXbp:setInputFocus:={| uNil1,uNil2,self | XbpBorder(self,GRA_CLR_BLUE) } oXbp:killInputFocus:={| uNil1,uNil2,self | XbpBorder(self, GRA_CLR_BACKGROUND) } oXbp:create() // added by Chris van Reeven (ALIAS) oXbp:=XbpStatic():new(oGroup2, , {12,12}, {40,24}) oXbp:caption:="Alias" oXbp:clipSiblings:=.T. oXbp:options:=XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_LEFT oXbp:create() oXbp:=XbpGet():new(oGroup2, , {47,12}, {110,24}) oXbp:tabStop:=.T. oXbp:bufferLength:=12 oXbp:picture:="@!" oXbp:dataLink:={|x| Iif(x==Nil, cAliasSLE, cAliasSLE:=x) } oXbp:create() oXbp:setInputFocus:={| uNil1,uNil2,self | XbpBorder(self,GRA_CLR_BLUE) } oXbp:killInputFocus:={| uNil1,uNil2,self | XbpBorder(self, GRA_CLR_BACKGROUND), cAliasSLE:=AllTrim(self:getData()) } oXbp:=XbpPushButton():new(drawingArea, , {12,12}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE }, { XBP_PP_FGCLR, -58 } }) oXbp:caption:=GEN_OPEN oXbp:tabStop:=.T. oXbp:create() oXbp:activate:={|| cFile:=aFiles[x], PostAppEvent(xbeP_Close+1000) } oXbp:=XbpPushButton():new(drawingArea, , {84,12}, {60,24}, { { XBP_PP_BGCLR, XBPSYSCLR_BUTTONMIDDLE }, { XBP_PP_FGCLR, -58 } }) oXbp:caption:=GEN_CANCEL oXbp:tabStop:=.T. oXbp:create() oXbp:activate:={|| cFile:="", PostAppEvent(xbeP_Close+1000) } oController:=XbpGetController():new(oDbeDlg):create() oController:read(,.F.) oDbeDlg:show() SetAppFocus(oDbe) nEvent:=xbe_None Do While nEvent<>xbeP_Close+1000 nEvent:=AppEvent(@mp1, @mp2, @oXbp) oXbp:handleEvent(nEvent, mp1, mp2) if nEvent == xbeP_Keyboard .and.; mp1 == xbeK_ESC exit endif EndDo oDbeDlg:destroy() bSaveErrorBlock:=ErrorBlock({|oError| Break(oError)}) Begin Sequence If !Empty(cFile) if Empty(cAliasSle) cAliasSle := cFile nAt := RAt('\', cFile) if nAt > 0 cAliasSle := SubStr(cAliasSle, (nAt + 1)) endif endif if IsDigit(cAliasSle) cAliasSle := ('f' + cAliasSle) endif nAt := At('.', cAliasSle) if nAt > 0 cAliasSle := Left(cAliasSle, (nAt - 1)) endif If !NetUse(cFile, lExclusive, cAliasSLE, ,cDefDbe, lReadOnly) SetAppFocus(oFocus) Break EndIf lRetVal:=.T. oBrowseDialog:=CreateBrowseWindow(oDlg, .T.) oBrowseDialog:file:=cFile oBrowseDialog:path:=Left(cFile,Rat("\",cFile)) oBrowseDialog:relations:={} oBrowseDialog:read_only:=lReadOnly EditBrowse(oBrowseDialog) SetAppFocus(oFocusBrowse) Else SetAppFocus(oFocus) EndIf End // Restore prior error block ErrorBlock(bSaveErrorBlock) Next Else If !NetUse(cOpenFile, lExclusive, , , cDefDbe) SetAppFocus(oFocus) Break EndIf lRetVal:=.T. oBrowseDialog:=CreateBrowseWindow(oDlg, .T.) oBrowseDialog:file:=cOpenFile oBrowseDialog:path:=Left(cOpenFile,Rat("\",cOpenFile)) oBrowseDialog:relations:={} oBrowseDialog:read_only:=.F. EditBrowse(oBrowseDialog) SetAppFocus(oFocusBrowse) EndIf End Return lRetVal ************** Func CloseFile() ************** Begin Sequence If !oFocusBrowse==Nil PostAppEvent(xbeP_Close, , , oFocusBrowse:setParent():setParent()) Close EndIf End Return Nil *********** Func AddRec() *********** * attempt to append a record LOCAL mwait:=2,lRetVal:=.F. Begin Sequence DbAppend() If !NetErr() lRetVal:=.T. Break EndIf Do While mwait>=0 DbAppend() If !NetErr() lRetVal:=.T. Break EndIf Inkey(1) If (--mwait)=0 Break EndIf EndDo End Return lRetVal ***************** Func CommitUnlock() ***************** * commit and unlock DbCommit() DbUnlock() Return Nil *********** Func NetUse(cFile, lExcUse, cAlias, lNoIndex, cDBE, lReadOnly) *********** * Open file for use Local mwait:=2,cFname,x,y,lRetVal:=.F.//, cFilePath:="" Local oError, bSaveErrorBlock:=ErrorBlock({|oError| Break(oError)}) Default(@lExcUse,.F.) Default(@lNoIndex,.F.) If !"NTX"$cDBE .And. !"CDX"$cDBE lNoIndex:=.F. EndIf Begin Sequence If Empty(cAlias) If "\"$cFile .Or. "."$cFile .Or. ":"$cFile x=Max(At(":",cFile),Rat("\",cFile)) y=Rat(".",cFile) y=IIf(y=0,Len(cFile)+1,y) cAlias:=SubStr(cFile,x+1,y-x-1) //cFilePath:=Iif(x>0,Left(cFile,x),cFile) Else cAlias:=cFile EndIf if IsDigit(cAlias) cAlias := ('f' + cAlias) endif cAlias:=UniqueAlias(cAlias) EndIf If "."$cFile y=Rat(".",cFile) cFile:=Left(cFile,y-1) EndIf cFname:=cFile If FileInUse(cFile) Break EndIf Do While mwait>=0 If lExcUse Set Exclusive On EndIf DbUseArea(.T.,cDBE,cFname,cAlias, ,lReadOnly) If lExcUse Set Exclusive Off EndIf If !NetErr() .And. !Select(cAlias)=0 If !lNoIndex .And. ("NTX"$cDBE .Or. "CDX"$cDBE) .And. File(cFile+OrdBagExt()) OrdListAdd(cFile+OrdBagExt()) OrdSetFocus(1) EndIf lRetVal:=.T. Break EndIf Inkey(1) If (--mwait)=0 Break EndIf EndDo Recover Using oError If !lRetVal Errm(ERR_ERRM60) EndIf End // Restore prior error block ErrorBlock(bSaveErrorBlock) Return lRetVal ************ Func RecLock() ************ * attempt to lock a record Local mwait:=2,lRetVal:=.F. Begin Sequence DbRLock() If !NetErr() lRetVal:=.T. Break EndIf Do While mwait>=0 DbRLock() If !NetErr() lRetVal:=.T. Break EndIf Inkey(1) If (--mwait)=0 Break EndIf EndDo End Return lRetVal ************ Func CopyRec(cFileFrom,cFileTo,lAppend) ************ * Note that this version assumes cFileTo file or existing record already * locked and always leaves the cFileTo record locked Local nFields, x, nFieldPos, w1, w2, lRetVal:=.T., nRecFrom, nRecTo, oFrom Default(@lAppend,.F.) w1:=Iif(cFileFrom=Nil,Select(),Select(cFileFrom)) w2:=Iif(cFileTo=Nil,Select(),Select(cFileTo)) Begin Sequence If lAppend If w1==w2 nRecFrom:=RecNo() EndIf If !(w2)->(AddRec()) lRetVal:=.F. Break EndIf If w1==w2 nRecTo:=RecNo() EndIf EndIf nFields:=(w1)->(Fcount()) For x:=1 To nFields If w1==w2 DbGoto(nRecFrom) oFrom:=FieldGet(x) DbGoto(nRecTo) FieldPut(x,oFrom) Else If (nFieldPos:=(w2)->(FieldPos((w1)->(FieldName(x))))) > 0 (w2)->(FieldPut(nFieldpos,(w1)->(FieldGet(x)))) EndIf EndIf Next End Return lRetVal ********** Func YesNo(cMessage,cTitle) ********** Local nButton, oXbp:=SetAppFocus(), lRetVal:=.F. Begin Sequence nButton:=ConfirmBox(SetAppWindow(), cMessage+"?", cTitle, ; XBPMB_YESNO , ; XBPMB_QUESTION+XBPMB_APPMODAL+XBPMB_MOVEABLE) If nButton==XBPMB_RET_YES lRetVal:=.T. EndIf SetAppFocus(oXbp) End Return lRetVal ************** Func EditBlock(cFieldName) ************** Local bBlock, cBlock Begin Sequence cBlock:="{|x| IIf(x==Nil,"+cFieldName+",WriteField('"+cFieldName+"',x)) }" bBlock:=&cBlock End Return bBlock *************** Func WriteField(cField, xValue) *************** Local cAlias:="" Begin Sequence If "->"$cField cAlias:=Left(cField,At("->",cField)-1) Else cAlias:=Alias() EndIf If (cAlias)->(RecLock()) &cField:=xValue (cAlias)->(CommitUnlock()) EndIf End Return xValue ************* Func NilValue(cType) ************* * Return blank value for data type Local xRetVal Begin Sequence Do Case Case cType=="N" xRetVal:=0 Case cType$"C,M" xRetVal:="" Case cType=="D" xRetVal:=Ctod(" / / ") Case cType=="L" xRetVal:=.F. EndCase End Return xRetVal ***************** Func StringLength(cString) ***************** Local aTextBox, oPS, oFont, nRetVal Begin Sequence cString:=Replicate("X",Len(cString)) oPS:=XbpPresSpace():new():create(SetAppWindow():drawingArea:winDevice()) oFont:=XbpFont():new(oPs):create("10.Arial") GraSetFont(oPs, oFont) GraStringAt(oPS, {-50,-50}, cString) // display off the dialog window aTextBox:=GraQueryTextBox(oPS, cString) oPS:destroy() nRetVal:=aTextBox[3,1]-aTextBox[2,1] // width of substring End Return nRetVal ********* Func XtoC(obj) ********* Local cRetVal Begin Sequence Do Case Case ValType(obj)=="N" cRetVal:=Str(obj) Case ValType(obj)="C" cRetVal:=obj Case ValType(obj)=="D" cRetVal:=Dtos(obj) Case ValType(obj)=="L" cRetVal:=IIf(obj,"Y","N") Case ValType(obj)="M" cRetVal:=AllTrim(obj) EndCase End Return cRetVal *************** Func AreasInUse() *************** * count number of areas in use Local nRetVal:=1 Begin Sequence Do While .T. If !(nRetVal)->(Used()) Exit EndIf nRetVal++ EndDo End Return nRetVal *************** Func AliasNames() *************** * Return array of alias names Local aRetVal:={}, x:=1 Begin Sequence Do While .T. If !(x)->(Used()) Exit EndIf Aadd(aRetVal,Alias(x)) x++ EndDo End Return aRetVal ****************** Func TestCondition(cCondition) ****************** Local oError, bSaveErrorBlock:=ErrorBlock({|oError| Break(oError)}) , lRetVal:=.T. Begin Sequence &(cCondition) // evaluate condition Recover Using oError Errm(ERR_ERRM61) lRetVal:=.F. End // Restore prior error block ErrorBlock(bSaveErrorBlock) Return lRetVal ************** Func AddFields(oFieldList, lNoConvert) ************** * add fields to listbox Local x, cDesc:="" Default(@lNoConvert,.F.) Begin Sequence For x:=1 To FCount() cDesc:=" ["+DbStruct()[x,DBS_TYPE]+","+Ntrim(DbStruct()[x,DBS_LEN])+","+Ntrim(DbStruct()[x,DBS_DEC])+"]" If lNoConvert oFieldList:addItem(FieldName(x)+cDesc) Else Do Case Case ValType(FieldGet(x))$"C" oFieldList:addItem(FieldName(x)+cDesc) Case ValType(FieldGet(x))="N" oFieldList:addItem("STR("+FieldName(x)+","+Ntrim(DbStruct()[x,DBS_LEN])+","+Ntrim(DbStruct()[x,DBS_DEC])+")"+cDesc) Case ValType(FieldGet(x))="D" oFieldList:addItem("DTOS("+FieldName(x)+")"+cDesc) Case ValType(FieldGet(x))$"L" oFieldList:addItem("IIF("+FieldName(x)+",'Y','N')"+cDesc) EndCase EndIf Next End Return Nil **************** Func UniqueAlias(cAlias) **************** Local x:=1 // cRetVal:="", // 04/29/03 by MMM Local n:=0 // 04/29/03 by MMM Begin Sequence n:=Select() If Select(cAlias)>=1 // 04/29/03 by MMM Do While .T. cAlias:=cAlias+Ntrim(x) // 04/29/03 by MMM If !Select(cAlias)>=1 // 04/29/03 by MMM Exit EndIf x++ EndDo EndIf // cRetVal:=Ntrim(x) // 04/29/03 by MMM Select(n) // 04/29/03 by MMM End Return cAlias // cRetVal // 04/29/03 by MMM ******************** Func CommitUnlockAll() ******************** * commit and unlock all DbCommitAll() DbUnlockAll() Return Nil **************** Func ListToArray(cList) **************** * splist comma separated string to array Local aRetVal:={} Begin Sequence If At(",",cList)==0 aRetVal:={AllTrim(cList)} Break EndIf Do While !Empty(cList) If At(",",cList)==0 Aadd(aRetVal,AllTrim(cList)) Break ElseIf At(",",cList)>0 Aadd(aRetVal,AllTrim(Left(cList,At(",",cList)-1))) cList:=Right(cList,Len(cList)-At(",",cList)) EndIf EndDo End Return aRetVal ************** Func FileInUse(cFile) ************** Local lRetVal:=.F., x:=1 Begin Sequence Do While .T. If !(x)->(Used()) Exit EndIf If Upper((x)->(DbInfo(DBO_FILENAME)))==Upper(cFile) lRetVal:=.T. Exit EndIf x++ EndDo End Return lRetVal *************** Func DisableXbp(oDlg, nNameID) *************** * Routine to temporarily disable an Xbase Part Local oXbp:=oDlg:childFromName(nNameID) Begin Sequence IF oXbp <> NIL oXbp:disable() EndIf End Return oXbp *************** Func EnableXbp(oDlg, nNameID) *************** * Routine to temporarily enable an Xbase Part Local oXbp:=oDlg:childFromName(nNameID) Begin Sequence IF oXbp <> NIL oXbp:enable() EndIf End Return oXbp ************** Func DupRecord() ************** * duplicate current record Begin Sequence If YesNo("Duplicate this record","Duplicate") CopyRec(,,.T.) oFocusBrowse:refreshAll() oFocusBrowse:forceStable() EndIf End Return Nil ************** Func FreezeCol() ************** * freeze left columns Local aFrozen, x Begin Sequence aFrozen:=oFocusBrowse:setLeftFrozen() If Len(aFrozen)1 oFocusBrowse:GetColumn(Len(aFrozen)):colorblock:={|| { Nil, Nil } } ARemove(aFrozen,Len(aFrozen),1) oFocusBrowse:setLeftFrozen(aFrozen) oFocusBrowse:refreshAll() oFocusBrowse:forceStable() EndIf End Return Nil ************** Func InsertRec() ************** * insert record Begin Sequence If AddRec() oFocusBrowse:refreshAll() oFocusBrowse:forceStable() EndIf End Return Nil ************** Func CopyField() ************** * copy field data xBuffer:=Eval(FieldBlock(oFocusBrowse:getColumn(oFocusBrowse:colpos):cargo)) Return Nil *************** Func PasteField() *************** * paste field data Local bField Begin Sequence bField:=FieldBlock(oFocusBrowse:getColumn(oFocusBrowse:colpos):cargo) If Empty(xBuffer) .Or. !(ValType(xBuffer)+ValType(Eval(bField))$"CCMMC" .Or. ValType(xBuffer)=ValType(Eval(bField))) Tone(100,1) ElseIf RecLock() Eval(bField,xBuffer) oFocusBrowse:refreshcurrent() CommitUnlock() EndIf End Return Nil ************* Func CutField() ************* * cut field data Local bField Begin Sequence If RecLock() xBuffer:=Eval(FieldBlock(oFocusBrowse:getColumn(oFocusBrowse:colpos):cargo)) bField:=FieldBlock(oFocusBrowse:getColumn(oFocusBrowse:colpos):cargo) Eval(bField,NilValue(ValType(xBuffer))) oFocusBrowse:refreshcurrent() CommitUnlock() EndIf End Return Nil ************** Func XbpBorder(oXbp,nColor,nPixels,lOverRide) ************** // draw a border around a xbp-part // oXbp is the part the will have the border // nColor is any of the GRA_CLR_xxx defines // nPixels is the width of the border // Thanks to B.I. Kaarigstad for this one. Local oArea:=oXbp:setParent(), aSize, aPos, oPS, i, aLineAttr:=array(GRA_AL_COUNT) Default(@nPixels,1) Default(@lOverRide,.F.) Default(@lHiliteGets,.T.) Begin Sequence If !lHiliteGets .And. !lOverRide Break EndIf If oArea:isDerivedFrom("XbpWindow") If nColor==Nil // remove previous border, just force a paint of the area so DON'T call this oArea:invalidateRect() // with no color from a paint codeblock Else aLineAttr[GRA_AL_COLOR]:=nColor aSize:=oXbp:currentSize() // get size, pos of the xbp-part aPos:=oXbp:currentPos() // and use it to calculate the corners oPS:=oArea:lockPS() GraSetAttrLine(oPS, aLineAttr) For i:=1 To nPixels aPos[1]-- // move one pixel away from the xbp-part aPos[2]-- aSize[1]+=2 aSize[2]+=2 GraLine(oPS,aPos,{aPos[1]+aSize[1],aPos[2]}) GraLine(oPs,Nil, {aPos[1]+aSize[1],aPos[2]+aSize[2]}) GraLine(oPs,Nil, {aPos[1],aPos[2]+aSize[2]}) GraLine(oPs,Nil, aPos) Next i oArea:unlockPS(oPS) EndIf EndIf End Return Nil **************** Func SaveSizePos() **************** * saves size and position of application in ini file Local aSize:={}, aPos:={}, aIniFile:={} Begin Sequence // get main dialog size and pos aSize:=SetAppWindow():currentSize() aPos :=SetAppWindow():currentPos() // check that app isn't minimized on exit, correct settings if is If aPos[1]<-1000 aSize:=AppDesktop():currentSize() aSize[1]:=aSize[1]*0.80 aSize[2]:=aSize[2]*0.80 aPos:=CenterPos(aSize,AppDesktop():currentSize()) EndIf // save size and pos into ini file aIniFile:=IniLoad(IniFileLoc()) IniPut(aIniFile, "WINDOW", "X-SIZE", Ntrim(aSize[1])) IniPut(aIniFile, "WINDOW", "Y-SIZE", Ntrim(aSize[2])) IniPut(aIniFile, "WINDOW", "X-POS", Ntrim(aPos[1])) IniPut(aIniFile, "WINDOW", "Y-POS", Ntrim(aPos[2])) IniSave(aIniFile, IniFileLoc()) End Return Nil ************* Func RemoveFileExt( cFile ) ************* * Remove last file extension from a file name * LOCAL cRet, nPos DEFAULT cFile TO "" cRet := cFile IF ! EMPTY(cFile) IF ( nPos := RAT(".", cFile) ) > 0 cRet := SUBSTR(cFile, 1, nPos-1) ENDIF ENDIF RETURN cRet *************** Func IniFileLoc() *************** Local cAppPath:=AppName(.T.) cAppPath:=SubStr(cAppPath, 1, Rat("\", cAppPath)) /* If ini file exists in the current directory, use this one instead of the one from the exe directory. */ IF FEXISTS(".\DbEditor.ini") cAppPath := ".\" ENDIF Return (cAppPath+"DbEditor.ini") FUNCTION FixNames( cName ) LOCAL lUpper, nI, cRet cRet := cName cName := ALLTRIM(cName) IF ! EMPTY(cName) lUpper := .T. FOR nI := 1 TO LEN(cName) IF IsLower(cName[nI]) lUpper := .F. EXIT ENDIF NEXT IF lUpper IF AT(" ", cName) = 0 cRet := Proper(cName) ENDIF ENDIF ENDIF RETURN cRet FUNCTION PROPER( cString ) LOCAL cRet := LOWER(cString) RETURN UPPER(cRet[1]) + SUBSTR(cRet,2) FUNCTION ConvertCharset(cString) LOCAL cSuch, nPos :=0, nPos2 STATIC aChars := {{"Ó","O"},; {"ó","o"},; {"Ā","A"},; {"ā","a"},; {"Ă","A"},; {"ă","a"},; {"Ą","A"},; {"ą","a"},; {"Ć","C"},; {"ć","c"},; {"Ĉ","C"},; {"ĉ","c"},; {"Ċ","C"},; {"ċ","c"},; {"Č","C"},; {"č","c"},; {"Ď","D"},; {"ď","d"},; {"Đ","D"},; {"đ","d"},; {"Ē","E"},; {"ē","e"},; {"Ĕ","E"},; {"ĕ","e"},; {"Ė","E"},; {"ė","e"},; {"Ę","E"},; {"ę","e"},; {"Ě","E"},; {"ě","e"},; {"ĝ","g"},; {"Ğ","G"},; {"ğ","g"},; {"Ġ","G"},; {"ġ","g"},; {"Ģ","G"},; {"ģ","g"},; {"Ĥ","H"},; {"ĥ","h"},; {"Ħ","H"},; {"ħ","h"},; {"Ĩ","I"},; {"ĩ","i"},; {"Ī","I"},; {"ī","i"},; {"Ĭ","I"},; {"ĭ","i"},; {"Į","I"},; {"į","i"},; {"İ","I"},; {"ı","i"},; {"IJ","I"},; {"ij","i"},; {"Ĵ","J"},; {"ĵ","j"},; {"Ķ","K"},; {"ķ","k"},; {"ĸ","k"},; {"Ĺ","L"},; {"ĺ","l"},; {"Ļ","L"},; {"ļ","l"},; {"Ľ","L"},; {"ľ","l"},; {"Ŀ","L"},; {"ŀ","l"},; {"Ł","L"},; {"ł","l"},; {"Ń","N"},; {"ń","n"},; {"Ņ","N"},; {"ņ","n"},; {"Ň","N"},; {"ň","n"},; {"ʼn","n"},; {"Ŋ","n"},; {"ŋ","n"},; {"Ō","O"},; {"ō","o"},; {"Ŏ","O"},; {"ŏ","o"},; {"Ő","O"},; {"ő","o"},; {"Œ","Œ"},; {"œ","œ"},; {"Ŕ","R"},; {"ŕ","r"},; {"Ŗ","R"},; {"ŗ","r"},; {"Ř","R"},; {"ř","r"},; {"Ś","S"},; {"ś","s"},; {"Ŝ","S"},; {"ŝ","s"},; {"Ş","S"},; {"ş","s"},; {"Š","Š"},; {"š","š"},; {"Ţ","T"},; {"ţ","t"},; {"Ť","T"},; {"ť","t"},; {"Ŧ","T"},; {"ŧ","t"},; {"Ũ","U"},; {"ũ","u"},; {"Ū","U"},; {"ū","u"},; {"Ŭ","U"},; {"ŭ","u"},; {"Ů","U"},; {"ů","u"},; {"Ű","U"},; {"ű","u"},; {"Ų","U"},; {"ų","u"},; {"Ŵ","W"},; {"ŵ","w"},; {"Ŷ","Y"},; {"ŷ","y"},; {"Ÿ","Y"},; {"Ÿ","Ÿ"},; {"Ź","Z"},; {"ź","z"},; {"Ż","Z"},; {"ż","z"},; {"Ž","Ž"},; {"ž","ž"},; {"ſ","s"}} IF VALTYPE(cString) == "C" DO WHILE (nPos := AT("&#", cString, nPos)) > 0 IF cString[nPos+5] == ";" cSuch := SUBSTR(cString,nPos,6) IF (nPos2 := ASCAN(aChars, cSuch)) > 0 cString := STRTRAN(cString,cSuch, aChars[nPos2,2]) ELSE nPos+=2 ENDIF ELSE nPos+=2 ENDIF ENDDO ENDIF RETURN cString