Friends have following problems
backspace doesnot deleted
bar scroll horizontal
text colur green commentar painted all
Here Source Code
#include "FiveWin.ch"
/// VISUAL EDITOR E INTERPRETE DE CODIGO
/* LIMITACIONES DEL INTERPRETE
- NO SOPORTA LOOP
- NO SOPORTA Local tc:=gsbus(_VG("PRO_2140"),'CAM'+xcod(),2) SE CONFUNDE SACA 3 VARIABLES
- NO SOPORTA SEPARADOR ; EN LINEAS
- NO FUNCIONA EL HSCROLL
- LOS ENDIF TIENE QUE ESTAR ESCRITOS COMPLETOS O SIN O SE CONFUNDEN CON ENDD
- NO SOPORTA COMANDOS DEBEN ESTAR PREPROCESADOS excperto los de flujo
IF
ELSE
ENDIF
IF ANIDADOS
DO CASE
CASE
OTHERWISE
ENDDO
WHILE
ENDDO
WHILE ANIDADOS
FOR I=1 TO 20
NEXT I
- TAMPOCO FUNCIONA CORTAR COPIAR PEGAR
- LAS VARIABLES STATIC
- CUANDO SE DECLARA VARIABLES Y SE LE ASIGNA
FUNCIONES CON SEPARADORES DE ,FALLA
Local factor:=DAMEFACTO(VZ("A->FCH_PRELIQ"),mon)
HOLA := NO ATRACA DEBE ESTRA JUNTO HOLA:=NO
LAS FUNCINOES NO PUEDEN DEVOLVER NADA NI SE LEES ASIGNA NADA TAMPOCO
no se puede declrar el mismo nombre de variable en dos funcinoes urge
cambiar la forma de manehar las var no pueden ser publicas debe
*/
/// ESTA MEJOR QUE EL TXTTEDIT DESCARTADO POR NO TENER VSCROLL
// Y NO PUEDO MODIFICAR EL PINTADO DE LINEAS
#define RELEASE_VER "Version 1.0"
#define EXE_VER "Editor "
REQUEST DBFNTX //,COMIX
REQUEST dbSelectArea, dbUseArea, dbCloseArea, dbSetIndex, dbAppend, __dbPack,;
__dbZap, dbunlock, dbunlockall, dbcommitAll, dbGoto, dbGotop, dbGoBottom,;
dbSkip, dbSeek, __dbContinue, __dbLocate, dbClearFilter,;
dbSetFilter, dbDelete, dbRecall, __dbCreate, __dbCopyXStruct, ;
__dbCopyStruct, __dbDelim, __dbSDF, __dbCopy, __dbApp, __dbSort,;
__dbTotal, __dbUpdate, __dbJoin, DbEval, __dblist, dbCloseAll, Set,;
dbClearIndex, ordCondset, ordcreate, dbCreateIndex, ordDestroy,;
ordlistrebuild, ordlistclear, ordlistadd, ordsetfocus, fieldput,;
fieldget, __SetCentury, Alert, Lfn2Sfn, Sfn2Lfn
REQUEST descend,alltrim,strtran,transform,padr,padl,padc
REQUEST IsAlpha, IsDigit, IsLower, IsUpper
REQUEST left, rat, right
REQUEST cursorarrow, cursorwait
REQUEST TDatabase
REQUEST SndPlaysound, nSerialHD
MEMVAR odlge
STATIC oSub1,oSub2
STATIC oDlg, oMemo, oMru, oChg, cText, cFile,eltexto,v150000,aUserFunc,aFuncLin,oUserCBX,;
lChanged, lNeedCmp, lPreProc, cIncPath,cUNO,cDOS,aVariables,aValores,Trace,Textacum,lNoCortar,tempo,UNASOLAVEZ,esunasolavez
//----------------------------------------------------------------------------//
FUNCTION ScriptEdit(cFileName,UNO,DOS)
LOCAL oFont, oIcon, oRow, oCol, odlgeFont,cIniFile,eFont
PUBLIC odlge
cUNO :=UNO
cDOS :=DOS
cFile := cFileName
cText := "" //MemoRead(cFile)
cIncPath := GetEnv("INCLUDE")
lchanged := .f.
lNeedCmp := .t.
lPreProc := .f.
v150000:=10
cIniFile := TakeOffExt(GetModuleFileName(GetInstance()))+".ini"
esunasolavez:=.T.
DEFINE FONT eFont NAME GetSysFont() SIZE 0,-12
DEFINE FONT oFont NAME "Fixedsys" SIZE 0,-10 //-18
//DEFINE FONT oFont NAME "Tahoma" SIZE 0,-12 //-18
DEFINE WINDOW odlge FROM 20,0 TO 27,80 ;
TITLE EXE_VER ;
MENU SetMenu(cIniFile)
SET MESSAGE OF odlge TO EXE_VER+ " "+RELEASE_VER + " Interprete de codigo " ;
FONT eFont
DEFINE MSGITEM oRow OF odlge:oMsgBar PROMPT "Row: 0" SIZE 70 ACTION oMemo:DlgGoLine()
DEFINE MSGITEM oCol OF odlge:oMsgBar PROMPT "Col: 0" SIZE 70
oMemo = TTxtEdit():New( 0, 0, 0, 0, odlge )
oMemo:SetFont( oFont )
odlge:oClient:= oMemo // to give it focus allways
oMemo:cFileName = cFileName
SetBar()
GetWinCoors(odlge, cIniFile)
SetWindowPos( oDlgE:hWnd, -1, 0, 0, 0, 0, 3 )
if File( cFileName )
oMemo:Load( cFileName )
odlge:SetText(EXE_VER+": "+cFileName)
aUserFunc:=dameaUserFunc()
oUserCbx:SetItems(aUserFunc)
IF LEN(aUserFunc)>0
oUserCbx:VarPut( aUserFunc[1] )
ENDIF
oMru:Save(lower(cFileName))
lNeedCmp := .t.
endif
oMemo:AdjClient()
oMemo:bChange = { |nKey| ChkMemo(nKey,oMemo), oRow:SetText( "Row: " + ;
LTrim( Str( oMemo:nLine ) ) ),;
oCol:SetText( "Col: " + ;
LTrim( Str( oMemo:nLineCol ) ) ) }
Eval( oMemo:bChange )
ACTIVATE WINDOW odlge ON INIT ( busca2Script(UNO,DOS)) ;
VALID (IIf(oMemo:lChanged .and. ;
MsgYesNo("Source code has changed, Save changes?",;
"Script Source code"),;
SaveFile(), ),;
SetWinCoors(odlge, cIniFile),;
oDlg == Nil)
RETURN nil
//27/06/2005
//----------------------------------------------------------------------------//
STATIC FUNCTION ChkMemo(nKey,oMemo)
/*
if Valtype(nKey) == "N" .and. nKey == 9
InsText(" ")
endif
*/
if oMemo:lChanged
if esunasolavez
DEFINE MSGITEM oChg OF odlge:oMsgBar PROMPT "Changed" SIZE 70 ;
COLOR CLR_WHITE, CLR_HRED
esunasolavez:=.F.
endif
endif
RETURN nil
//----------------------------------------------------------------------------//
//27/06/2005
STATIC FUNCTION SaveFile(lSaveAs) //ok
Local cScrFile
DEFAULT lSaveAs := .f.
if Empty(cFile) .or. lSaveAs
cScrFile := cGetFile("Clipper file (*.prg) |*.prg|","Program File Save", 1, cFile,.t.)
else
cScrFile := cFile
endif
if !Empty(cScrFile)
cFile := cScrFile
oMemo:SaveToFile(cFile)
esunasolavez:=.t.
oMemo:SetFocus()
odlge:SetText(EXE_VER+": "+upper(cFile))
oMru:Save(lower(cFile))
lChanged := .f.
if oChg != nil
odlge:oMsgBar:DelItem(oChg)
oChg := NIL
Endif
endif
RETURN NIL
//----------------------------------------------------------------------------//
//27/06/2005
STATIC FUNCTION OpenFile(cNewFile) //OK
Local cScrFile
if cNewFile != Nil
cScrFile := cNewFile
else
cScrFile:=cGetFile("Program | *.prg |"+"All files |*.*|","Vas a Editar que programa","*.prg",rclipper()+"\program")
endif
if !Empty(cScrFile)
cFile := cScrFile
oMemo:cFileName = cFile
if File( cFile )
oMemo:SetText( memoread( cFile ) )
endif
oMemo:AdjClient()
Eval( oMemo:bChange )
odlge:SetText(EXE_VER+": "+cFile)
aUserFunc:=dameaUserFunc()
oUserCbx:SetItems(aUserFunc)
IF LEN(aUserFunc)>0
oUserCbx:VarPut( aUserFunc[1] )
ENDIF
oMru:Save(lower(cScrFile))
lNeedCmp := .t.
endif
RETURN NIL
//27/06/2005
STATIC FUNCTION buscaScript(modo)
Local nFor,cLine,cText:=space(200)
Local nLines := len(oMemo:aLines)
If MsgGet("Busca","Texto",@cText)
cText:=alltrim(UPPE(cText)) ;nFor := 1
eltexto:=cText
// ?"cual es el maldito texto",eltexto,cText
WHILE nFor<=nLines
cLine := oMemo:aLines[nFor]
//?cLine
IF AT(cText,UPPE(cLine))>0
oMemo:GoLine( nFor )
retu .t.
ENDIF
nFor++
ENDDO // nFor
ENDIF
MsgAlert(cText,"No se encontro")
retu .t.
//27/06/2005
STATIC FUNCTION Sigebuscando(dire)
Local cLine,nLines:=len(oMemo:aLines),nFor
//?"que vale el texto",elTexto,valtype(elTexto),"nFor",nFor,"dire",dire,"nlines",nLines,nFor<=nLines
If empty(eltexto);retu .t.;end
eltexto:=alltrim(eltexto)
If dire=1
nFor:=oMemo:nLine()+1
WHILE nFor<=nLines
cLine := oMemo:aLines[nFor]
IF AT(uppe(elTexto),UPPE(cLine))>0
oDlgE:SetFocus()
oMemo:GoLine( nFor )
retu .t.
ENDIF
nFor++
ENDDO // nFor
else
nFor:=oMemo:nLine()-1
WHILE nFor>0
cLine := oMemo:aLines[nFor]
//oDlgE:SetText( ltrim(str(nFor))+" "+If(AT(uppe(elTexto),UPPE(cLine))=0,"Buscando ","Encontrando ")+uppe(elTexto)+" en "+UPPE(cLine) )
IF AT(uppe(elTexto),UPPE(cLine))>0
oMemo:GoLine( nFor )
//MsgRun( "Encontrado "+uppe(elTexto),"Linea "+ltrim(str(nFor)) )
retu .t.
ENDIF
nFor--
ENDDO // nFor
endif
MsgAlert(elTexto,"No hay mas coincidencias con ")
retu .t.
// 27/06/2005
FUNCTION busca2Script(UNO,DOS)
local hWnd := GetActiveWindow()
Local nFor:=1,cLine
Local nLines
IF VALTYPE(UNO)="U";retu .t.;endif
IF VALTYPE(oMemo)="U";retu .t.;endif
nLines:=len(oMemo:aLines)
WHILE nFor<=nLines
cLine := allTrim(oMemo:aLines[nFor])
IF AT(UNO,UPPE(cLine))>0 .OR. AT(DOS,UPPE(cLine))>0
//SetWindowText(hWnd, "Ubicando "+UNO+" en la linea "+ltrim(str(nFor)) )
oMemo:GoLine( nFor )
retu .t.
ENDIF
nFor++
ENDDO // nFor
retu .t.
//27/06/2005
Static Func CompileScript
Local nomprog,nobj
Local rharbour:="c:\x\bin\harbour"
Local rinclude:="c:\x\include"
Local rbcc32:="c:\x\bin\bcc32"
Local bat:=''
If empty(cFile);retu .t.;endif
//MSGALERT(cFile)
cFile:=ALLTRIM(cfile)
nomprog:=SUBS(cfile,RAT("\",cfile)+1)
nomprog:=SUBS(nomprog,1,AT(".PRG",uppe(nomprog))-1)
//MSGALERT(nomprog,"NOMPROG")
nobj:=nomprog+".obj"
bat+=Rharbour+' '+Rclipper()+'program\'+nomprog+'.prg /n /i'+rinclude+' /oc:\'+CURDIR()+'\obj32\'+nomprog+'.c /p >resu.txt'+chr(13)
MEMOWRIT("corre.bat",bat)
waitrun("corre.bat")
vztext("resu.txt")
WAITRUN( Rbcc32+' -M -c -O2 -I'+rinclude+' -tW -oc:\'+curDIR()+'\obj32\'+nomprog+'.obj c:\'+curdir()+'\obj32\'+nomprog+'.c + >>resu.txt' )
retu nil
//------------------------------------------------------------------------//
//27/06/2005
STATIC FUNCTION SetMenu(cIniFile)
LOCAL oMenu, oItem
MENU omenu
MENUITEM "&File"
MENU
MENUITEM "&Open" ACTION OpenFile()
MENUITEM "&Save" ACTION SaveFile()
MENUITEM "Save &as ..." ACTION SaveFile(.t.)
SEPARATOR
MENUITEM "&End" ACTION odlge:End()
MRU oMru FILENAME cIniFile ;
SECTION "Last files" ;
ACTION OpenFile(cMruItem) ;
SIZE 9
ENDMENU
MENUITEM "&Edit"
MENU
MENUITEM "&Cut" ACTION oMemo:Cut()
MENUITEM "C&opy" ACTION oMemo:Copy()
MENUITEM "&Paste" ACTION oMemo:Paste()
MENUITEM "&Redo" ACTION oMemo:Redo(),oMemo:Sefocus()
MENUITEM "&Undo" ACTION oMemo:Undo(),oMemo:Sefocus()
SEPARATOR
ENDMENU
MENUITEM "&Search"
MENU
MENUITEM "&Find ... " ACTION buscaScript(0)
MENUITEM "Find next " ACTION sigebuscando(1)
MENUITEM "Find previous" ACTION sigebuscando(2)
ENDMENU
MENUITEM "&Program"
MENU
MENUITEM "&Compile " ACTION CompileScript()
/*
MENUITEM "&Interprete " ACTION ejecutafile(1) ;
WHEN !Empty(cText) .and. oDlg == Nil
MENUITEM "Step &by Step" ACTION ejecutafile() ;
WHEN !Empty(cText) .and. oDlg == Nil
*/
MENUITEM "&Ventana Comandos " ACTION vtnacmd()
MENUITEM "&Verify Step &by Step " ACTION vzText("TRACE.TXT")
MENUITEM "&Ajustar tiempo de espera interprete" ACTION MsgGet("Tiempo","Espera",@v150000 )
MENUITEM oSub1 PROMPT "Mostrar despues de vzcommit" ACTION oSub1:SetCheck( ! oSub1:lChecked ) CHECKED
MENUITEM oSub2 PROMPT "Mostrar despues de vzdbseek" ACTION oSub2:SetCheck( ! oSub2:lChecked ) CHECKED
ENDMENU
MENUITEM "&SQL"
MENU
MENUITEM "Verify &INSERT UPDATE Y SELECT" ACTION vzText("HISTORY.TXT")
ENDMENU
ENDMENU
RETURN oMenu
//------------------------------------------------------------------------//
//27/06/2005
STATIC FUNCTION SetBar()
LOCAL oBar, oCursor,cCombo,oCbx,avzs,UserFunc,oBtn
DEFINE CURSOR oCursor HAND
DEFINE BUTTONBAR oBar SIZE 26, 26 3D OF odlge
DEFINE BUTTON NAME "OPEN" OF oBar NOBORDER ;
TOOLTIP "Open source file" ;
ACTION OpenFile()
DEFINE BUTTON NAME "SAVE" OF oBar NOBORDER;
TOOLTIP "Save source file" ;
ACTION SaveFile()
DEFINE BUTTON oBtn NAME "TABLES" OF oBar NOBORDER;
TOOLTIP "Ver tablas activas" ;
ACTION verTablesActiv(oBtn)
DEFINE BUTTON NAME "CUT" OF oBar NOBORDER GROUP;
TOOLTIP "Cut to Clipboard" ;
ACTION (oMemo:Cut())
DEFINE BUTTON NAME "COPY" OF oBar NOBORDER;
TOOLTIP "Copy to Clipboard" ;
ACTION (oMemo:Copy())
DEFINE BUTTON NAME "PASTE" OF oBar NOBORDER;
TOOLTIP "Paste from Clipboard" ;
ACTION (oMemo:Paste())
DEFINE BUTTON NAME "compile" OF oBar NOBORDER GROUP ;
TOOLTIP "Compile program " ;
ACTION CompileScript()
DEFINE BUTTON NAME "search" OF oBar NOBORDER GROUP ;
TOOLTIP "Find " ;
ACTION buscaScript(0)
DEFINE BUTTON NAME "search1" OF oBar NOBORDER GROUP ;
TOOLTIP "Find next " ;
ACTION sigebuscando(1)
DEFINE BUTTON NAME "search2" OF oBar NOBORDER GROUP ;
TOOLTIP "Find previous " ;
ACTION sigebuscando(2)
DEFINE BUTTON NAME "golin" OF oBar NOBORDER GROUP ;
TOOLTIP "Go to Line" ;
ACTION vealalinea()
DEFINE BUTTON NAME "PLAY" OF oBar NOBORDER;
TOOLTIP "Ventana de comandos" ;
ACTION vtnacmd()
DEFINE BUTTON NAME "SCRIPT" OF oBar NOBORDER;
TOOLTIP "Interprete paso a paso" ;
ACTION vtnaint(UserFunc)
DEFINE BUTTON NAME "mas" OF oBar NOBORDER;
TOOLTIP "Mas veloc. Interprete" ;
ACTION v150000-=10
DEFINE BUTTON NAME "menos" OF oBar NOBORDER;
TOOLTIP "Menos Veloc Interprete" ;
ACTION v150000+=10
DEFINE BUTTON NAME "STOP" OF oBar NOBORDER;
TOOLTIP "Detener Interprete " ;
ACTION lNoCortar:=.f.
oBar:bRClicked := {|| NIL }
Aeval(oBar:aControls, {|oCtl| oCtl:oCursor := oCursor})
avzs:=dameavzs()
aUserFunc:=dameaUserFunc()
if len(aUserFunc)>0;UserFunc:=aUserFunc[1];end
@ 0,65 COMBOBOX oUserCBX Var UserFunc ITEMS aUserFunc SIZE 140,500 OF oBar ON CHANGE veaestafunc(UserFunc)
cCombo:="VZ"
@ 0,82 COMBOBOX oCBX Var cCombo ITEMS avzs SIZE 150,400 OF oBar ON CHANGE cargavzs(cCombo)
RETURN NIL
//----------------------------------------------------------------------------//
//27/06/2005
#define WM_PASTE 770 // 0x302
STATIC FUNCTION InsText(cTxt)
LOCAL oclp
DEFINE CLIPBOARD oClp OF oMemo FORMAT TEXT
oClp:SetText(cTxt)
oMemo:SendMsg( WM_PASTE )
Eval( oMemo:bSetGet, cText )
oMemo:SetFocus()
oClp:End()
RETURN NIL
//--------------------------------------------------------------------------//
#define HWND_TOPMOST -1
#define SWAP_NOSIZE 1
#define SWAP_NOMOVE 2
#define RT_DIALOG 5
//------------------------------------------------------------------------//
//-------------------------------------------------------------------------//
#define ST_NORMAL 0
#define ST_ICONIZED 1
#define ST_ZOOMED 2
//27/06/2005
STATIC FUNCTION GetWinCoors(odlge,cIniFile)
LOCAL oIni
LOCAL nRow, nCol, nWidth, nHeight, nState
nRow := odlge:nTop
nCol := odlge:nLeft
nWidth := odlge:nRight-odlge:nLeft
nHeight := odlge:nBottom-odlge:nTop
IF IsIconic( odlge:hWnd )
nState := ST_ICONIZED
ELSEIF IsZoomed(odlge:hWnd)
nState := ST_ZOOMED
ELSE
nState := ST_NORMAL
ENDIF
INI oIni FILE cIniFile
GET nRow SECTION "Coordenadas" ;
ENTRY "Fila" DEFAULT nRow OF oIni
GET nCol SECTION "Coordenadas" ;
ENTRY "Columna" DEFAULT nCol OF oIni
GET nWidth SECTION "Coordenadas" ;
ENTRY "Ancho" DEFAULT nWidth OF oIni
GET nHeight SECTION "Coordenadas" ;
ENTRY "Alto" DEFAULT nHeight OF oIni
GET nState SECTION "Coordenadas" ;
ENTRY "Modo" DEFAULT nState OF oIni
GET cIncPath SECTION "Pre-processor" ;
ENTRY "IncludePath" DEFAULT cIncPath OF oIni
ENDINI
IF nRow == 0 .AND. nCol == 0
WndCenter(odlge:hWnd)
ELSE
odlge:Move(nRow, nCol, nWidth, nHeight)
ENDIF
IF nState == ST_ICONIZED
//odlge:Minimize()
ELSEIF nState == ST_ZOOMED
//odlge:Maximize()
ENDIF
odlge:CoorsUpdate()
RETURN NIL
//-------------------------------------------------------------------------//
//27/06/2005
STATIC FUNCTION SetWinCoors(odlge,cIniFile)
LOCAL oIni
LOCAL nRow, nCol, nWidth, nHeight, nState
odlge:CoorsUpdate()
nRow := odlge:nTop
nCol := odlge:nLeft
nWidth := odlge:nRight-odlge:nLeft
nHeight := odlge:nBottom-odlge:nTop
IF IsIconic( odlge:hWnd )
nState := ST_ICONIZED
RETU NIL
ELSEIF IsZoomed(odlge:hWnd)
nState := ST_ZOOMED
RETU NIL
ELSE
nState := ST_NORMAL
ENDIF
INI oIni FILE cIniFile
SET SECTION "Coordenadas" ;
ENTRY "Fila" TO nRow OF oIni
SET SECTION "Coordenadas" ;
ENTRY "Columna" TO nCol OF oIni
SET SECTION "Coordenadas" ;
ENTRY "Ancho" TO nWidth OF oIni
SET SECTION "Coordenadas" ;
ENTRY "Alto" TO nHeight OF oIni
SET SECTION "Coordenadas" ;
ENTRY "Modo" TO nState OF oIni
SET SECTION "Pre-processor" ;
ENTRY "IncludePath" TO cIncPath OF oIni
ENDINI
RETURN NIL
//-------------------------------------------------------------------------//
//27/06/2005
STATIC FUNCTION TakeOffExt(cFile)
local nAt := At(".", cFile)
if nAt > 0
cFile := Left(cFile, nAt-1)
endif
RETURN cFile
//-------------------------------------------------------------------------//
//27/06/2005
//-------------------------------------------------------------------------//
FUNCTION MsgArray( aArray, cMsg )
LOCAL cText := ""
DEFAULT cMsg := ""
Aeval(aArray, {|v,e| cText += Str(e,3) + ": "+cValToChar(v)+CRLF})
MsgInfo(cText, cMsg)
RETURN NIL
//27/06/2005
FUNCTION ejecutaFile(n,inilinea,pcfunc)
Local _nFor:=1,nFor,cLine,dato,resuwhile:=.f.,x,y,aParam,cParam,nwvar,VALOnwvar:=SPACE(100)
Local tLine:="",kwhile:=0
Local nLines := len(oMemo:aLines),resucond:=.T.,lacond
Local aLinWhile := {},variable,valor,j,nextLine,kmasWhile:=0
Local aLinBloq:={},ubi,knFor,kif,BLOQUEAYA //arreglo de lineas bloqueadas para las estructuras IF ELSE ENDIF
Local kuserFunc:=0,aLinUserFunc:={},velin,nwcLine,nAt,resucase,EVALUACASE
aVariables:={} ; aValores:={} ;Trace:="" ;Textacum:=""
lNoCortar:=.t.
If !empty(pcfunc)
cUNO:="FUNC "+ALLTRIM(oPPE(pcfunc))
cDOS:="FUNCTION "+ALLTRIM(oPPE(pcfunc))
endif
WHILE _nFor<=nLines
cLine := oMemo:aLines[_nFor] ;tLine += cLine
IF AT(cUNO,UPPE(cLine))>0 .OR. AT(cDOS,UPPE(cLine))>0
EXIT
retu .t.
ENDIF
_nFor++
ENDDO // nFor
_nFor++
IF _nFor<=nLines ;nFor:=_nFor
if (x:=at("(",cLine))>0 .and. (y:=at(")",cLine))>0 // hay parametros
cParam:=subs(cLine,x+1,y-x-1)
If !empty(cParam)
aParam:=llenarray(cParam,0)
For j=1 to len(aParam) ;nwVar:=aParam[j]
PUBLIC &nwVar
aadd(aVariables,nwVar)
MsgGet("Parametro ",nwVar ,@VALOnwvar)
VALOnwvar:=alltrim(VALOnwvar)
if vcerror(VALOnwvar)
&nwVar:=&VALOnwvar
else
&nwVar:=VALOnwvar
endif
next j
endif
endif
while nFor<=nLines .and. lNoCortar;cLine := allTrim(oMemo:alines[nFor])
//?ascan(aLinBloq,nfor),cLine,uppe(subs(cLine,1,7))="DO CASE" .AND. ascan(aLinBloq,nfor)=0
FOR2WHILE(@cLine) // TRANSFORMA EL FOR EN WHILE
NEXT2ENDDO(@cLine) // INCREMENTA LA VAR DEL FOR Y GENERA EL ENDDO
// Si la linea ANTERIOR ha sido bloquead liberarla de arreglo por que ya fue ejecutada
// INDAGAR SI LA PROXIMA LINEA ES UN WHILE
IF ascan(aLinBloq,nfor+1)=0
If nFor+1<=len(oMemo:alines)
nextLine := allTrim(oMemo:alines[ nFor+1])
else
nextLine :=space(200)
Endif
if uppe(subs(nextLine,1,5))="WHILE" .OR. uppe(subs(nextLine,1,4))="FOR "
// primero hay que ver si la linea actual es un if
if uppe(subs(cLine,1,2))="IF";lacond:=ALLTRIM(subs(cLine,3))
if vcerror(lacond); resucond:=&lacond;end
if resucond // buscar el else y bloquear todas sus lineas hasta llegar al endif
kwhile++
endif
else
kwhile++
endif
//?"incrementado kwhile",kwhile
endif
ENDIF
//VeraLinBloq(aLinBloq,nFor)
IF nFor>1
if (ubi:=ascan(aLinBloq,nFor-1))>0
ADEL(aLinBloq,ubi );aSize(aLinBloq, len(aLinBloq)-1)
endif
Endif
//cLine := Trim(oMemo:alines[ nFor])
tLine += cLine
//cLine := alltrim(cLine)
if empty(cLine);nFor++;loop;end
if uppe(subs(cLine,1,4))=="ELSE"; nfor++;loop;endif
//?"descartando es endif",uppe(subs(cLine,1,5)),uppe(subs(cLine,1,5))=="ENDIF"
if uppe(subs(cLine,1,5))=="ENDIF"
nfor++;loop
endif
// ?"nFor",nFor,"cLine",cLine,"aLinbloq",VeraLinBloq(aLinBloq)
if subs(uppe(cLINE),1,4)="EXIT"
if ascan(aLinBloq,nfor)=0
While nFor<=nLines;cLine :=allTrim(oMemo:alines[ nFor] )
if uppe(subs(cLine,1,4))=="ENDD";kwhile--;exit;endif
nFor++
Enddo
loop
endif
Endif
if subs(uppe(cLINE),1,4)="RETU"
if ascan(aLinBloq,nfor)=0
if kuserFunc=0;exit
else; nFor:=aLinUserFunc[kuserFunc]+1
ADEL(aLinUserFunc,kuserFunc )
aSize(aLinUserFunc, len(aLinUserFunc)-1)
kuserFunc--
loop
endif
endif
// if resucond;exit;end
else
//if puntoycoma(cLine,@nFor,nLines,n);loop;end
if ignorar(cLine,@nFor,nLines);loop;end
acomodar(@cLine)
if (uppe(subs(cLine,1,5))="WHILE" .OR. uppe(subs(cLine,1,4))="FOR ") .AND. ascan(aLinBloq,nfor)=0
if ascan(aLinWhile,nFor)=0
aadd( aLinWhile,nfor )
endif
lacond:=ALLTRIM(subs(cLine,6))
if nFor>=val(inilinea);MsgcLine( cLine,nFor,N );end
if vcerror(lacond); resuwhile:=&lacond;end
// ?"Resultado de while condicion ",resuwhile
if resuwhile
else ;nFor++
kmasWhile:=0
while nFor<=nLines;cLine :=allTrim(oMemo:alines[ nFor])
//?"DESCARTE",nFor,cLine,uppe(subs(cLine,1,4)),uppe(subs(cLine,1,4))=="ENDD"
if (uppe(subs(cLine,1,4))=="ENDD" .or. uppe(subs(cLine,1,5))="NEXT ") .and. kmasWhile=0
ADEL(aLinWhile,kwhile )
aSize(aLinWhile, len(aLinWhile)-1)
//veraLinWhile(aLinWhile)
kwhile--
exit
end
if uppe(subs(cLine,1,5))=="WHILE" .OR. uppe(subs(cLine,1,4))=="FOR ";kmasWhile++;endif
if uppe(subs(cLine,1,4))=="ENDD" .OR. uppe(subs(cLine,1,5))="NEXT ";kmasWhile--;endif
nFor++
enddo
endif
nFor++;LOOP
elseif (uppe(subs(cLine,1,4))="ENDD" .OR. uppe(subs(cLine,1,5))="NEXT ") .AND. ascan(aLinBloq,nfor)=0
//?"EN EL ENDD kwhile",kwhile,veraLinWhile(aLinWhile,1)
IF kwhile>0
nfor:=aLinWhile[kwhile]
ELSE
nfor++
ENDIF
loop
elseif uppe(subs(cLine,1,9))=="OTHERWISE" .AND. ascan(aLinBloq,nfor)=0
nfor++
LOOP
elseif uppe(subs(cLine,1,4))="CASE" .AND. ascan(aLinBloq,nfor)=0
nfor++
LOOP
elseif uppe(subs(cLine,1,7))="DO CASE" .AND. ascan(aLinBloq,nfor)=0
knFor:=nfor+1;EVALUACASE:=.T.
while knFor<=nLines;nwcLine :=allTrim(oMemo:alines[knFor])
if uppe(subs(nwcLine,1,7))=="ENDCASE" ;EXIT;END
IF EVALUACASE //1234567890
if uppe(subs(nwcLine,1,4))=="CASE" .OR. uppe(subs(NWcLine,1,9))=="OTHERWISE"
IF uppe(subs(NWcLine,1,9))="OTHERWISE"
resucase:=.T.
ELSE
CONDCASE:=ALLTRIM(SUBS(nwcLine,5))
IF (NAT:=AT("/",CONDCASE))>0; CONDCASE:=SUBS(CONDCASE,1,NAT-1); ENDIF
//?"CONDCASE",CONDCASE
resucase:=&CONDCASE
ENDIF
?"resucase ",resucase,nwcLine
if resucase //RECORRE TODO EL SGMTI DE COIGO Q DEBE EJECUTARSE PARA EVITAR QUE SE BLOQUEE
knFor++
while knFor<=nLines;nwcLine :=allTrim(oMemo:alines[knFor])
if uppe(subs(nwcLine,1,7))=="ENDCASE" .or. uppe(subs(nwcLine,1,4))=="CASE" .OR. uppe(subs(nwcLine,1,9))=="OTHERWISE"
EXIT
ENDIF
knFor++
enddo
EVALUACASE:=.F. // NO EVALUES MAS CASES
endif
endif //BLOQUEAR LINEAS DEL ELSE
ENDIF
aadd(aLinBloq,knFor)
knFor++
enddo
nfor++
LOOP
elseif uppe(subs(cLine,1,7))="ENDCASE" .AND. ascan(aLinBloq,nfor)=0
nfor++
LOOP
elseif uppe(subs(cLine,1,2))="IF" .AND. ascan(aLinBloq,nfor)=0
lacond:=ALLTRIM(subs(cLine,3))
if nFor>=val(inilinea);MsgcLine( cLine,nFor,N );end
if vcerror(lacond)
lacond:=ACURSOR2FLDGET(lacond)
//MSGALERT(lacond,"lacond")
resucond:=&lacond
end
if resucond // buscar el else y bloquear todas sus lineas hasta llegar al endif
knFor:=nfor+1 ; kif:=0 ;BLOQUEAYA:=.F.
while knFor<=nLines;cLine :=allTrim(oMemo:alines[knFor])
if uppe(subs(cLine,1,5))=="ENDIF" .and. kif=0;EXIT;END
if uppe(subs(cLine,1,4))=="ELSE" .and. kif=0;BLOQUEAYA:=.T.;endif //BLOQUEAR LINEAS DEL ELSE
IF BLOQUEAYA ; aadd(aLinBloq,knFor) ; Endif
if uppe(subs(cLine,1,2))=="IF";kif++;endif
if uppe(subs(cLine,1,5))=="ENDIF" ;kif--;endif
knFor++
enddo
else // bloquear todas las lineas del if hasta llegar al else o endif y altera el nfor hasta el else o endif
knFor:=nfor+1 ; kif:=0 //;BLOQUEAYA:=.t.
while knFor<=nLines;cLine :=allTrim(oMemo:alines[ knFor])
if uppe(subs(cLine,1,5))=="ENDIF" .and. kif=0;nfor:=knFor;EXIT;END
if uppe(subs(cLine,1,4))=="ELSE" .and. kif=0;nfor:=knFor;EXIT;endif
//IF BLOQUEAYA ; aadd(aLinBloq,knFor) ; Endif
if uppe(subs(cLine,1,2))=="IF";kif++;endif
if uppe(subs(cLine,1,5))=="ENDIF" ;kif--;endif
knFor++
enddo
endif
nfor++;loop
endif
//?" que narizes vale resucond",resucond,cLine
If ascan(aLinBloq,nfor)=0//resucond
if nFor>=val(inilinea);MsgcLine( cLine,nFor,N );end
// oMemo:GoTo(nFor)
// oMemo:SetSel( 1, len(tLine) )
If (x:=AT("=",cLine))=0 // NO Es una asignacion
/*
If nFor>=218
?"que devuelve Estafuncion(cLine,nFor) ",Estafuncion(cLine,nFor)
endif
*/
if (velin:=Estafuncion(cLine,nFor))>0
kuserFunc++;aadd(aLinUserFunc,nFor) // linea donde regresara el flujo
nFor:=velin // Ahora debe ubicarme en la linea de la funcion
loop
else
if vcerror(cLine); dato:=&cLine ;endif
//12345678
if SUBS(alltrim(uppe(cLine)),1,8)="VZCOMMIT"
if oSub1:lChecked; vzmybrow();endif
endif //12345678
if SUBS(alltrim(uppe(cLine)),1,8)="VZDBSEEK"
if oSub2:lChecked; vzmybrow();endif
endif
endif
else
If subs(alltrim(cLine),1,1)="("
if vcerror(cLine); dato:=&cLine ;endif
else
variable:=subs(cLine,1,x-1)
if at(":",variable)>0
variable:=subs(variable,1,len(variable)-1)
endif
valor :=alltrim(subs(cLine,x+1))
//?variable," = ",valor,at("(",variable)=0
if at("(",variable)=0
if at("(",valor)=0
//?"815 variable",variable,"VALOR",valor
&variable:=&valor
x:=&variable
else // la ultima se trara de una funcino que devuelve valor que se asigna a var
if (velin:=Estafuncion(valor,nFor))>0
kuserFunc++;aadd(aLinUserFunc,nFor) // linea donde regresara el flujo
nFor:=velin // Ahora debe ubicarme en la linea de la funcion
loop
else
&variable:=&valor
//?"variable",variable
x:=&variable
endif
endif
else //te confundiste es una funcion que usa el signo =
if (velin:=Estafuncion(cLine,nFor))>0
kuserFunc++;aadd(aLinUserFunc,nFor) // linea donde regresara el flujo
nFor:=velin // Ahora debe ubicarme en la linea de la funcion
loop
else
if vcerror(cLine); dato:=&cLine ;endif
endif
endif
// ?"valor final de variable ",x
endif
endif
Endif
endif
nFor++
Enddo
ENDIF
retu .t.
Static Function Estafuncion(cLine,nFor)
Local j:=1,userfunc,cfunc
// es una funcion
/*
If nFor>=218
?len(aUserFunc),cLine
?(AT("(",cLine)>0 .and. AT(")",cLine)>0)
?(alltrim(uppe(subs(cLIne,1,2)))="VZ")
endif
*/
If AT("(",cLine)>0 .and. AT(")",cLine)>0
else
retu(0)
endif
// es vz
if alltrim(uppe(subs(cLIne,1,2)))="VZ"
retu(0)
Endif
// existe en el combo
userfunc:=alltrim(subs(cLine,1,at("(",cLine)-1))
while j<=len(aUserFunc)
IF at("(",aUserFunc[j])>0
cfunc:=alltrim(subs(aUserFunc[j],1,at("(",aUserFunc[j])-1))
ELSE
cfunc:=alltrim(aUserFunc[j])
ENDIF
/*
If nFor>=218
*/
// ?"BUSCANDO",aUserFunc[j],cfunc==userfunc,cfunc,userfunc
/*
endif
*/
If UPPE(cfunc)==UPPE(userfunc)
RETU(aFuncLin[j])
Endif
j++
Enddo
retu(0)
STATIC Func ignorar(cLine,nFor,nLines)
Local CARA2:=CHR(47)+CHR(42),C2ARA:=CHR(42)+CHR(47)
if subs(cLine,1,2)=CARA2
//?Subs(cLine,1,2)=CARA2,cLine,NFOR,NLINES
nFor++
while nFor<=nLines
cLine := allTrim(oMemo:alines[ nFor])
//?"ignorarndo",cLine,at(C2ARA,cLine)
if at(C2ARA,cLine)>0
//
nFor++
retu .t.
endif
nFor++
enddo
endif
if subs(cLine,1,2)="//" .or. subs(cLine,1,1)="*"
nFor++
retu .t.
ENDIF
retu .f.
STATIC FUNCTION puntoycoma(cLine,nFor,nLines,m)
Local n,linea,dato
if (n:=at(";",cLine))=0
retu .F.
endif
while .t.
linea:=subs(cLine,1,n-1) ;cLine:=subs(cLine,n+1)
acomodar(@cLine)
If !empty(m)
MsgcLine( cLine,nFor )
endif
if subs(uppe(cLINE),1,4)="RETU"
nFor:=nLines+50
retu .t.
endif
if vcerror(cLine)
dato:=&cLine
endif
if n:=at(";",cLine)=0;exit;endif
enddo
nFor++
retu .t.
STATIC Func MsgcLine( cLine,nFor,N )
Local valor,mcrut,X,oDlgb,nWidth
LOCAL cText := "Variable Valor "+h()+"------------------------------"+h(),j
Local cMsg :="Interpreta linea "+ltrim(str(nFor))
For j=1 to len(aVariables)
valor:=""
mcrut:=aVariables[j]
IF VCERROR(mcrut)
valor:=&mcrut
ENDIF
cText+=aVariables[j]+" = "+convcadena(valor)+h()
next j
cText +="Area en Curso "+ltrim(str(select()))+" Interpretando linea "+LTRIM(STR(nFor))+h()+"------------------------------"+h()
cText +=cLine+h()+h()+h()
iF EMPTY(N)
MsgInfo(cText, cMsg)
Trace+=cText+"------------------------------"+h()+h()
ELSE
ODLGE:sETFOCUS()
oMemo:GoLine(nFor)
HideCaret( oMemo:hWnd )
oMemo:DrawLine( oMemo:nLine(), oMemo:nLineRow + 1, 255 )
ShowCaret( oMemo:hWnd )
oMemo:SetFocus()
//MsgRun(cLine, cMsg, { || myv150000() })
DEFINE DIALOG oDlgb FROM 0,0 TO 4, Max( Len( cLine ), Len( cMsg ) ) + 4 TITLE cMsg STYLE DS_MODALFRAME
oDlgb:bStart := { || oDlgb:Hide() , myv150000() , oDlgb:End(), SysRefresh() }
ACTIVATE DIALOG oDlgb
oDlgE:SetText(ltrim(str(nFor))+" "+cLine)
setosay(cText)
//Trace+=cLine+h()
//Textacum+=cLine+h()
//MsgRun(cLine, cMsg)
ENDIF
//MemoWrit("TRACE.TXT",Trace )
retu .t.
Static Func myv150000
Local x:=1
while X<=v150000
if lNoCortar
else
exit
endif
//oDlgE:SetText("vuelta "+ltrim(str(x)) )
x++
enddo
retu .t.
//retu({1,LEN(nwText) }) FUNCIONA
retu({((LEN(OLDnwText)+1)+((nFor-1)*2)),(LEN(nwText)+(nFor*2)) }) // FUNCIONARA
Static Func convcadena(valor)
Do case
case valtype(valor)="O";valor:="Object"
case valtype(valor)="A";valor:="Array"
case valtype(valor)="U";valor:="NIL"
case valtype(valor)="N";valor:=str(valor)
case valtype(valor)="D";valor:=dtoc(valor)
case valtype(valor)="L";valor:=if(valor,"T","F")
Endcase
retu valor
STATIC Func acomodar(cLine)
Local aVars,j,variable,valor,n
IF (n:=AT("//",cLine))>0
cLine:=SUBS(cLine,1,n-1)
ENDIF
Do case
case (n:=AT("++",cLine))>0;cLine:=SUBS(cLine,1,n-1)+"="+SUBS(cLine,1,n-1)+"+1"
case (n:=AT("--",cLine))>0;cLine:=SUBS(cLine,1,n-1)+"="+SUBS(cLine,1,n-1)+"-1"
case (n:=AT("+=",cLine))>0;cLine:=SUBS(cLine,1,n-1)+"="+SUBS(cLine,1,n-1)+"+"+SUBS(cLine,n+2)
case (n:=AT("-=",cLine))>0;cLine:=SUBS(cLine,1,n-1)+"="+SUBS(cLine,1,n-1)+"-"+SUBS(cLine,n+2)
case uppe(subs(cLine,1,5))="LOCAL"
cLine:=subs(cLine,6)
aVars:=llenarray(cLine,0);cLine:=""
For j=1 to len(aVars)
If at("=",aVars[j])=0;aVars[j]:=aVars[j]+":="+chr(34)+chr(34);endif
cLine+=aVars[j]+","
variable:=subs(aVars[j],1,at("=",aVars[j])-1)
if at(":",variable)>0;variable:=subs(variable,1,len(variable)-1);end
aadd(aVariables,variable)
//msgalert(variable,"DECLARA ESTA VARIABLE ")
PUBLIC &variable
valor:=subs(aVars[j],at("=",aVars[j])+1)
aadd(aValores,valor)
Next j
cLine:="("+subs(cLine,1,len(cLine)-1)+")"
case uppe(subs(cLine,1,7))="SELECT("
case uppe(subs(cLine,1,5))="SELE"
SELECT(VAL(VSELE(ALLTRIM(subs(cLine,6)))))
cLine:="SELECT("+VSELE(ALLTRIM(subs(cLine,6)))+")"
Endcase
RETU .T.
STATIC FUNC VSELE(AREA)
IF VAL(AREA)=0
AREA:=LTRIM(STR(ASC(UPPE(AREA))-64))
ENDIF
RETU(AREA)
//1234
STATIC FUNCTION dameaUserFunc()
Local nFor,cLine
Local nLines := len(oMemo:alines)
Local aFunc:={}
aFuncLin:={}
nFor:=1
WHILE nFor<=nLines
cLine := allTrim(oMemo:alines[ nFor])
//?cLine,alltrim(subs(cLine,at(" ",cLine))),subs(UPPE(cLine),1,4)=="FUNC"
IF subs(UPPE(cLine),1,4)=="FUNC"
aadd(aFunc,alltrim(subs(cLine,at(" ",cLine))) )
aadd(aFuncLin,nFor)
ENDIF
nFor++
ENDDO // nFor
retu(aFunc)
Func VeraLinBloq(aLinBloq,nFor)
Local j,txt:="Lineas en alinbloq "
For j=1 to len(aLinBloq)
txt+=ltrim(str(aLinBloq[j]))+", "
next j
//msgstop(txt)
retu TXT
Func veraLinWhile(aLinWhile)
Local j,txt:="Lineas en alinwhile "
For j=1 to len(aLinWhile)
txt+=ltrim(str(aLinWhile[j]))+", "
next j
RETU(txt)
/////////////// POR FIN LA ASIENDAD DOCUMENTACION EN EL EDITOR ///////////////////////////
FUNC dameavzs()
Local avzs:={"vz","vzuse_","vzskip","vzeof","vzgotop",;
"vzgobottom","vzgoto","vzgo","vzrecno",;
"vzbof","vzreccount","vzfieldget","vzrlock","vzcommit",;
"vzcloseall","vzdele","vzrepl","vzfieldname","vzmasca",;
"vzfieldput","vzfieldget","vzquery",;
"vzdbseek","vzascan","vzfcount","vzappend","vzrefresh","vzdelete","vzappe",;
"vzseek","vzquery","vzexecute","vzselectdb",;
"vzloa","vzgraba","vzeditbrow","vzgrabas","vzfile","vzminimiza",;
"vztext","vzmybrow","vzyear","vzachoice","vzbrowse","vzconsis","vzhi"}
retu( avzs )
Func cargavzs(qvz)
Local textpegar:=""
qvz:=alltrim(UPPE(qvz))
DO CASE
CASE qvz=="VZ"
textpegar:="vz( alias - > Nombre de campo )"
CASE qvz=="VZUSE"
textpegar:="vzuse_(dbf,indice,comparte,orden,nuevo,alias,driver,sololee)"
CASE qvz=="VZSKIP"
textpegar:="VZSKIP(n)"
CASE qvz=="VZGOTO"
textpegar:="VZgoto(nRecno)"
CASE qvz=="VZGO"
textpegar:="VZgo(nRecno)"
CASE qvz=="VZREPL"
textpegar:="VZrepl(campo.valor)"
CASE qvz=="VZFIELDNAME"
textpegar:="VZfieldname(nField)"
CASE qvz=="VZMASCA"
textpegar:="VZmasca(campo,area)"
CASE qvz=="VZFIELDPUT"
textpegar:="VZfieldPut(nField,uValue)"
CASE qvz=="VZFIELDGET"
textpegar:="VZFieldGet(nField)"
CASE qvz=="VZQUERY"
textpegar:="VZQuery(cSelect,aStruLen,sStruDec)"
CASE qvz=="VZDBSEEK"
textpegar:="VZDBSEEK(aValores,aCampos,lhaydbf,fields,OBY,xStruLen,xStruDec,SUMARIO,NLIKE,LIMITE,WHERE )"
CASE qvz=="VZAPPEND"
textpegar:="VZAppend(aValores,aCampos,flag)"
CASE qvz=="VZDELETE"
textpegar:="VZDelete(aValores,aCampos)"
CASE qvz=="VZSEEK"
textpegar:="VZSeek(xSearch,NoCampo,lDescend)"
CASE qvz=="VZSELECTDB"
textpegar:="VZSelectDb(nwbase,Dns)"
CASE qvz=="VZLOA"
textpegar:="VZLoa(Cja,n)"
CASE qvz=="VZGRABA"
textpegar:="VZGraba(cForm,lCerrar)"
CASE qvz=="VZEDITBROW"
textpegar:="VZEditBrow(nKey,colbxFolder,Pagima,xnowait)"
CASE qvz=="VZGRABAS"
textpegar:="VZGrabas(cForm,lCerrar)"
CASE qvz=="VZFILE"
textpegar:="VZFile(tabla)"
CASE qvz=="VZYEAR"
textpegar:="VZYear(fecha)"
CASE qvz=="VZACHOICE"
textpegar:="VZAchoice(fs,cs,fi,ci,aSample,titulo,Head,posi)"
CASE qvz=="VZASCAN"
textpegar:="VZAscan(arreglo,dato)"
CASE qvz=="VZEli"
textpegar:="VZEli(nobj,area)"
CASE qvz=="VZBrowse"
textpegar:="VZBrowse(cTitle,aHeadrs,bInit,bdlbClick,UseFunc,CapFunc)"
CASE qvz=="VZCONSIS"
textpegar:="vzconsis(cnobj , caCod , caTitu )"
ENDCASE
iF MsgNoYes("la syntax de esta funcion en su editor."+h()+textpegar,"Desea Pegar")
oMemo:SetFocus()
oMemo:SetSel( 0, 0 )
oMemo:Goto( oMemo:GetLineCount() )
__Keyboard( Chr( VK_END ) )
oMemo:Paste( textpegar )
endif
retu .t.
//27/06/2005
Static Func verTablesActiv(oBtn)
Local atables:=dametablasactiv(),n,bblock,buf:=select()
LOCAL oMenu
Local area
Local objsql,plus
MENU oMenu POPUP
For n=1 to len(atables)
area:=val(subs(atables[n],1,at("-",atables[n] )-1 ) )
Select(area); objsql:=dameobjsql()
If valtype(objsql)="O"
plus:= ltrim(str(objsql:nRowCount() ))+" registros"
else
plus:="No hay Cursor Cargado"
endif
bblock:=&(" { |oMenuItem| _verTable_("+chr(34)+atables[n]+chr(34)+") } ")
MenuAddItem( atables[n]+" "+plus,, .F.,, bblock ,,,,,,, .F.,,, .F. )
next n
ENDMENU
ACTIVATE POPUP oMenu AT oBtn:nBottom, 0 OF oBtn//+oBtn:nHeight , 0 OF oBtn
Select(buf)
RETU .T.
//27/06/2005
Static Func _verTable_(table)
Local buf:=select(),objsql
Local area:=val(subs(table,1,at("-",table)-1 ) )
Local latabla:=subs(table,at("-",table)+1 )
Select(area); objsql:=dameobjsql()
If valtype(objsql)="O"
IF objsql:nRowCount()>0
vzMyBrow()
ELSE
MsgAlert("No hay registros en el area "+ltrim(str(select())),"Error" )
ENDIF
else
MsgAlert("No hay cursor cargado en el area "+ltrim(str(select())),"Error" )
endif
Select(buf)
retu .t.
//27/06/2005
STATIC FUNCTION vealalinea
Local nLin:=1
If MsgGet("Ingrese","Nº Linea",@nLin)
oMemo:GoLine( nLin )
Endif
retu .t.
//27/06/2005
Static Function veaestafunc(UserFunc)
if valtype(aFuncLin)="A"
if len(aFuncLin)>0
if oUserCBX:NAt>0
oMemo:GoLine( aFuncLin[ oUserCBX:NAt ] )
oMemo:SetFocus()
endif
endif
endif
retu .t.
// 1111
// 1234567890123
// FOR I=1 TO 10
STATIC FUNC FOR2WHILE(cLine) // TRANSFORMA EL FOR EN WHILE
LOCAL VARINC,NAT,INI,FIN,CEXP,COND,RESU
IF UPPE(SUBS(cLine,1,4))="FOR "
VARINC:=ALLTRIM(SUBS(cLine,4));CEXP:=UPPE(VARINC)
IF (NAT:=AT("=",VARINC))>0
VARINC:=SUBS(VARINC,1,NAT-1)
ELSE;MSGALERT("NO PUSO EL SIGNO = DESPUES DE LA VARIABLE DEL FOR ","ERROR")
ENDIF
//?"CEXP",CEXP,AT("=",CEXP)+1,AT("TO ",CEXP)-AT("=",CEXP)-1
INI:=ALLTRIM(SUBS(CEXP,AT("=",CEXP)+1,AT("TO ",CEXP)-AT("=",CEXP)-1 ) )
FIN:=ALLTRIM(SUBS(CEXP,AT("TO ",CEXP)+3) )
//?VARINC,INI
IF VALTYPE(UNASOLAVEZ)="U"
&VARINC=&INI
UNASOLAVEZ:=1
ENDIF
cLine:="WHILE "+VARINC+"<="+FIN
COND:=VARINC+"<="+FIN
//?"cond",cond
RESU:=&COND
IF RESU
ELSE
UNASOLAVEZ:=NIL
ENDIF
//FORMANDO EL WHILE ",cLine
ENDIF
RETU .T.
STATIC FUNC NEXT2ENDDO(cLine) // INCREMENTA LA VAR DEL FOR Y GENERA EL ENDDO
lOCAL VARINC,NAT,MCRUT
IF UPPE(SUBS(cLine,1,5))="NEXT "
VARINC:=ALLTRIM(SUBS(cLine,5))
IF (NAT:=AT("/",VARINC))>0
VARINC:=SUBS(VARINC,1,NAT-1)
ENDIF
&VARINC:=&VARINC+1
cLine:="ENDDO"
//"FORMANDO EL ENDDO ",cLine,"J",J
ENDIF
RETU .T.
// CONVIRTIENDO UN ACURSOR A FLDGET
FUNC ACURSOR2FLDGET(exp)
Local p1,n,campo,noLbx,obj,pos,on
on:=at("ACURSOR:FLDGET(",UPPE(exp))
if (n:=at("ACURSOR:",UPPE(exp)))=0 ;RETU(exp);endif
IF n=on;RETU(exp);endif
exp:=uppe(exp)
// 1 2 3 4 5 6
// 123456789012345678901234567890123456789012345678901234567890
// EMPTY(VZDBSEEK({ oLbx:aCursor:NUME_ORDEN },{"NUME_ORDEN"} ) )
// ------p1--------------1234567
p1:=subs(exp,1,n-1)
//?"p1",p1
IF (n:=RAT(" ",p1))=0
IF (n:=RAT("}",p1))=0
IF (n:=RAT(")",p1))=0
IF (n:=RAT(",",p1))=0
IF (n:=RAT("+",p1))=0
ENDIF
ENDIF
ENDIF
ENDIF
endif
noLbx:=subs(p1,n+1)
noLbx:=subs(noLbx,1,len(noLbx)-1)
//?"noLbx",noLbx
obj:=&noLbx
//?obj:aCursor:ClassName()
campo:=alltrim(subs(exp,n+8))
IF (n:=AT(" ",campo))=0
IF (n:=AT("}",campo))=0
IF (n:=AT(")",campo))=0
IF (n:=AT(",",campo))=0
IF (n:=AT("+",campo))=0
ENDIF
ENDIF
ENDIF
ENDIF
endif
p2:=subs(campo,n+1)
//?"p2",p2
campo:=subs(campo,1,n-1)
campo:=subs(campo,at(":",campo)+1)
//?"campo",campo
pos:=mifieldpos(obj:aCursor,campo)
//?"pos",pos
exp:=p1+"aCursor:FldGet("+ltrim(str(pos))+")"+p2
//?"exp ",exp
retu exp