Editor de Codigo con syntaxis coloreada interperte y texto i

[Vladimir Zorrilla]

Estimados Amigos se puede hacer con fw un editor con texto inteligente
interprete y syntaxis coloreada .

Estoy desarrollandolo pero tengo los siguientes problemas

- El backspace no borra

- El scroll horizontal no funciona

- El pintado de el texto en verde e comentario cuando se hace pagina arriba abajo pinta todo


Me gustaria que el interprete fuera el de xharbour no tengo ni idea
de como enlazarlo aqui

- Como le pongo el texto inteligente que me permita mostrar un tooltip
con


El editor es una funcion

ScriptEdit(cFileName,UNO,DOS)

He aqui el codigo




#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

[quique]

Si se puede, un ejemplo de uno en desarrollo 100% fivewin/xharbour lo puedes ver en

ftp://ftp.quiquesoft.com/qsvisual.zip

Puedes tomar como base la clase ttxtedit