Juan Planelles Lazaga

[Juan Planelles]

Tengo una aplicación en la clase CLASS TFGet y no consigo que se justifiquen bien las líneas, ¿Alguien tiene el código adecuado?. Me sería muy útil. Gracias. - Juan -

[Antonio Linares]

Juan,

Puedes poner un pequeño ejemplo que reproduzca ese efecto que comentas para revisarlo ? gracias

[Juan Planelles]

Hola Antonio, Felices Navidades.

Se quiere justificar solamente en la impresora.
Te envío en código que uso: metodo PRINT pasado a función para perssonalizarlo un poco, y desde ahí se llama a la funcion JUSTIFIC, en la que lo único que se hace es recorrer el texto de la línea caracter uno a uno y los espacios vacios se duplican y a continuación se comprueba el nuevo ancho de la linea. La justificación es correcta pero no se corresponden las posiciones de los espacios de la linea ( colocados con INSCHAR(..) ) con las posiciones obtenidas desde el texto. Incluso en lineas en las que no hay codigos de formato.

Te envío las dos funciones.

Gracias por tu rápido interes en comunicarte.

Saludos: - Juan -

//METHOD Print() CLASS TFGet

Static Function Imprimir( oGet, cName, oFontX, nColorX )

local n, nMargen := 4, nCols, nFilas, nFactor := 0.70, nFilaIni := 2, lUser := .t., aJustif := {}

local xxx := 0, cLine, cLinea, nAncho, nCar, nC, cTx2, cVal := ""

local nRow := 0, nRowNw := 0
local nCol := 0, nI := 0

local nWidth //, oLin := oGet:oLineInit
local nRowStep

local oLine := oGet:oLineInit

local cText, cMemo := MemoRead( CFGAYUDA ), nWEdit := Eval({|| oGet:nWidth })

local oFontW, nFont, oFont2, nMargend
local nLenFonts := Len( oGet:aFonts )
local aFonts := Array( nLenFonts ), cTextForm, nCrLf, lFocus, cChars

local lFile32 := ( File( 'Prev32.Dll' ) .or. ;
File( AllTrim( GetSysDir() ) + '\Prev32.Dll' ) )

//aVal := { nFilaIni, lPrev, nMargen, nFactor }
nFilaIni := Val( AllTrim( memoLine( cMemo, , 1 ) ) )
lPrev := ( AllTrim( memoLine( cMemo, , 2 ) ) == "S" )
lPrevIni := ( AllTrim( memoLine( cMemo, , 5 ) ) == "S" )
lCuart := ( AllTrim( memoLine( cMemo, , 8 ) ) == "S" )
nMargend := Val( AllTrim( memoLine( cMemo, , 9 ) ) )
if lPrev .and. !( lFile32 )
? 'Prev32.Dll: NO Instalado' + CRLF + ;
'PREIMPRESOS NO DISPONIBLES.'
lPrev := .f.
endif

nMargen := Val( AllTrim( memoLine( cMemo, , 3 ) ) )
nFactor := Val( AllTrim( memoLine( cMemo, , 4 ) ) ) // Para modificar tamaño al imprimir
nFactor := Max( nFactor, 0.20 )
lPrevIni := ( AllTrim( memoLine( cMemo, , 5 ) ) == "S" )

DEFINE FONT oFont2 NAME GetSysFont() SIZE 0, -12

// oPrn := TPrinter():New( cName, .f., lPrev )
cNamePre := "Fichero: " + cName
if lPrev
PRINT oPrn NAME cNamePre PREVIEW
else
PRINT oPrn NAME cNamePre
endif
lMetaf := lPrev
//cNamePre := cName
if Empty( oPrn:hDC )
MsgStop( "Impresora no preparada !", "Aviso !." )
oPrn := ""; lMetaf := .f. ; lPrev := .f.
return oGet
endif

nCols := oPrn:nHorzRes()/80 // 80 columnas, numero de pixels por columna para ciertas cosas
nFilas:= oPrn:nVertRes()/70 // 70 lineas por pagina
nFilaIni:= nFilas*nFilaIni
nMargen := nCols*nMargen
nMargend := nCols*nMargend
CursorWait()
DbUseArea( .t., , "Lis_Red", , .t. ) // modo compartido
Lis_Red->( DbGoto( nUsuario ) )

for n:= 1 to nLenFonts
oFontW:= oGet:aFonts[ n ]
if oFontW:nWidth == oFontW:nHeight * 0.44
aFonts[ n ] := TFont():New( iif( Empty( oFontW:cFaceName ), "Arial", oFontW:cFaceName ), ;
0, ( Abs( oFontW:nHeight ) * -1 )*nFactor, ,;
oFontW:lBold, , , , oFontW:lItalic, oFontW:lUnderline,;
oFontW:lStrikeOut, , , , , oPrn )
else
aFonts[ n ] := TFont():New( iif( Empty( oFontW:cFaceName ), "Arial", oFontW:cFaceName ), ;
( oFontW:nWidth )*nFactor, ( oFontW:nHeight )*nFactor, ,;
oFontW:lBold, , , , oFontW:lItalic, oFontW:lUnderline,;
oFontW:lStrikeOut, , , , , oPrn )
endif
next
//oPrn:StartPage()
nI := 0
PAGE
nI++
if (lFile) .and. ( lMembr ) .and. nI == 1
nRow := membrete( oPrn, oFont2, GetWndDefault(), "", .f., "P", , nMargen, nFilas, nCols, nFilaIni, ;
oFontX, nColorX )
endif


// Primero comprobar que el ancho de resolucion horiz impresora no se sobrepasa
nWidth := 0
do while oLine != nil
nRowStep := 0
nWidth := 0

for n = 1 to Len( oLine:aText )
cText := oLine:aText[ n ]
nFont := AScan( oGet:aFonts, { |oFontW| oFontW:hFont == oLine:aFonts[ n ] } )
nFont := Max( 1, nFont )
oFontW := aFonts[ nFont ]

nWidth += oPrn:GetTextWidth( cText, oFontW )
nRowStep := Max( nRowStep, Abs( oFontW:nHeight ) )

next

aadd( aJustif, ( oPrn:nHorzRes() -nMargend ) - ( nWidth + nMargen ) ) // array con diferencias a justificar
xxx := MAX( xxx, nWidth )
oLine := oLine:oDown
enddo

if ( nMargen + xxx ) > ( oPrn:nHorzRes() -nMargend )
MsgWait( "Hay líneas demasiado anchas." + CRLF + ;
"Estreche la ventana o los márgenes.", "Aviso !", 0.8 )
else

endif
// Fin de la comprobacion

// Inicio de imprimir
oLine := oGet:oLineInit

do while oLine != nil

// Para comprobar si va a caber en la pagina
nRowStep := 0
nWidth := 0
for n = 1 to Len( oLine:aText )
cText := oLine:aText[ n ]
nFont := AScan( oGet:aFonts, { |oFontW| oFontW:hFont == oLine:aFonts[ n ] } )
nFont := Max( 1, nFont )
oFontW := aFonts[ nFont ]
nWidth += oPrn:GetTextWidth( cText, oFontW )
nRowStep := Max( nRowStep, Abs( oFontW:nHeight ) )
next
nRow += nRowStep // esto era lo original de la clase

if nRow + nFilaIni > oPrn:nVertRes()
nRow := nFilaIni
ENDPAGE
PAGE
// oPrn:EndPage()
// oPrn:StartPage()
endif
// fin comprobar si cabe en la pagina

SetTextAlign( oPrn:hDC, nMargen ) //TA_BASELINE )
do case
case oLine:nAlign == ES_LEFT
nCol := nMargen + 0 // p q haya un margen izq
case oLine:nAlign == ES_RIGHT
nCol := oPrn:nHorzRes() - ( nWidth + nMargend )
nCol := nCol -nMargen // p q haya un margen dcho
case oLine:nAlign == ES_CENTER
nCol := ( oPrn:nHorzRes() - nWidth ) / 2
endcase

// Justificar si se ha elegido, las lineas que procedan
if lJustif .and. !( oLine:lCrLf ) .and. oLine:nAlign == ES_LEFT .and. ( aJustif[ oGet:nLineRow ] > 0 ) .and. ;
aJustif[ oGet:nLineRow ] < ( oPrn:nHorzRes() -nMargend - nMargen )*0.50 // Justificar las alineadas a la izquierda
oLine := Justify( oGet, oLine, oPrn, nMargen, nMargend, aJustif[ oGet:nLineRow ], oFontW )
endif

nRowStep := 0
nWidth := 0

for n = 1 to Len( oLine:aText )

if oLine == oGet:oLineInit
nRow := nRow + nFilaIni - Abs( oFontW:nHeight )
endif

cText := oLine:aText[ n ]
nFont := AScan( oGet:aFonts, { |oFontW| oFontW:hFont == oLine:aFonts[ n ] } )
nFont := Max( 1, nFont )
oFontW := aFonts[ nFont ]

// nRow := nRow - Abs( oFont:nHeight ) // esto era lo original de la clase
nRowNw := nRow - Abs( oFontW:nHeight )*0.85 // p resituar las fuentes grandes

oPrn:Say( nRowNw, nCol, cText, oFontW, , oLine:aColors[ n ] )
nCol += oPrn:GetTextWidth( cText, oFontW )
nWidth += oPrn:GetTextWidth( cText, oFontW )
next

nCol := 0

oLine := oLine:oDown

enddo
//oPrn:EndPage() //
ENDPAGE

//OutPrint() //
ENDPRINT

AEval( aFonts, { |oFontW| oFontW:End() } )
oFont2:End()
Lis_Red->( DbCloseArea() )
CursorArrow()

return nil

Static Function Justify( oGet, oLine, oPrn, nMargen, nMargend, nJustif, oFontW )
local nPos, cLine := "", cChar := " ", nWidthChar := 0, aOpt := {}
local xxx := 0, nVez := 0, nJust := 0, nI, lSeguir := .t., n, nFont, aText, cLinea, cIni, nIni
local cTx2, cMemo := MemoRead( CFGAYUDA ), nWidth, nWidMemo
local nLenFonts := Len( oGet:aFonts ), nRowStep
local aFonts := Array( nLenFonts ), nLen, nChar, cEdit, cTc, cT
local cLineText, bEvalWidt, cTextForm := oGet:GetTextLine( oLine )
local aVar := {}, nAt, aLen := {}, aL := {}, nVar := 0, aLenText := Len( oLine:aText )
local nPosLine := oGet:nLineRow, aTextLine := oLine:aText, aFontsLine := oLine:aFonts, ;
aColorsLine := oLine:aColors
local nFactor := Val( AllTrim( memoLine( cMemo, , 4 ) ) )
nFactor := Max( nFactor, 0.20 )

bEvalWidt := {|| lSeguir := .t., nWidth := 0, ; // Evaluar el ancho del texto
aEval( oLine:aText, {|c,nx| nI := nx, ;
cText := oLine:aText[ nI ], ;
nFont := AScan( oGet:aFonts, { |oFontW| oFontW:hFont == oLine:aFonts[ nI ] } ),;
nFont := Max( 1, nFont ), ;
oFontW := aFonts[ nFont ], ;
nWidth += oPrn:GetTextWidth( cText, oFontW ), ;
lSeguir := iif( !( ( nMargen + nWidth ) < ( oPrn:nHorzRes() -nMargend ) ), .f., lSeguir ) ;
} ) }

cLineText := oGet:GetTextLine( oLine )
cLineText := Trim( cLineText )
nIni := Len( cLineText ) - Len( Ltrim( cLineText ) ) // si hay espacios iniciales
nIni := Max( 1, nIni ) // no vale cero

oGet:GetDC()

Do While lSeguir

cLineText := Trim( cLineText )
nLen := Len( cLineText )
For n = nIni To nLen // se recorre la linea entera elemento a elemento
cTc := SubsTr( cLineText, n, 1 )
if cTc == " "
cLineText := Stuff( cLineText, n, 2, " " ) // se inserta en el texto que sirve de guía

oGet:InsChar( oLine, n, " " ) //CHR( 32 ) ) //Space( 1 ) ) //" " ) // Se intenta insertar en su posición
oGet: DrawCurLine() // INLINE ::DrawLine( ::oLine, ::nRow, .t., .t. )
oGet:Refresh()

nLen++ // la nueva longitud del texto
n ++ // re-posicionarse
Eval( bEvalWidt ) // Se evalua el nuevo ancho obtenido
if !lSeguir
exit
endif

endif
Next
if !lSeguir
exit
endif
EndDo

return oLine

//----------------------------------------------------------------------------//

[Antonio Linares]

Juan,

Felices fiestas

Puedes proporcionar un PRG completo y autocontenido que podamos compilar y probar aqui directamente ? gracias

[Juan Planelles]

Antonio, lo tengo preparado.

Van: Leeme.Txt, WOCAYUD8.PRG, H0012008.MH1 y CFGAYUDA.001.

No se, como hacer, ¿te pongo aquí todo el texto?, es mucho, ¿o por e-mail en forma de ficheros? (dime entonces la dirección).

Espero lo que me digas.

Saludos: - Juan -

[Juan Planelles]

Te los pongo:

1.- LEEME.TXT
29-12-09

Estimado Antonio Linares:

He preparado el PRG para que tea lo mas sencillo.

Va WOCAYUD8.PRG, H0012008.MH1 ( Es un txt de hsitorias del programa qWOCUL3.EXE que hace la llamada a WOCAYUD8.EXE con el nombre como parámetro, y CFGAYUDA.001 que son los datos de configuracion para imprimir: Previsualizar, justificar y márgenes.

Se genera el exe con: Buildh Wocayud8

Pulsar: Archivo / Abrir y H0012008.MH1, o bien,

en la carpeta C:\FWH\SAMPLES, si están los tres ficheros solo hay que ejecutar:

WOCAYUD8 H0012008.MH1

y se abrirá la ventana correspondiente (he modificado los botones a textos ..), pulsando entonces el botón "prn" se previsualiza la impresión.

Saludos y muchas gracias: - Juan -

2.- H0012008.MH1 (Es el texto de prueba a editar)
GTF1Arial160.401100Arial219.241100Batang219.241100010PLANELLES LAZAGA, JUAN - Última historia - H0012008.MH1.

- Consulta: 147 del paciente.
PLANELLES LAZAGA, JUAN - Edad: 69.5 - Fecha: 22/11/2007.

ANTECEDENTES PERSONALES .-
Comentarios a las principales 2funcionalidades del entorno encabezado1 y pie de página (pág. 13)
Con respecto a la nota que has puesto en pág. 12 dorso: 2255Si se hace así10, se borra el pie de página anteriormente creado. Para evitarlo, colocar el curso después del pie de página, clic sobre el botón nº de página y escoger posición actual y números en negrita (muy abajo). Después, desplazar con la barra espaciadora el nº de pág. Con de total de pág. Hasta el borde derecho.
El formato n/nn (p. Ej. 7/31) no existe (o yo no lo veo) en el cuadro de diálogo. Para conseguirlo hay que ponerlo a mano: En cualquier página borrar la palabra "de" y los dos espacios, y escribir la barra. Esto afecta a todas las páginas.
Al insertar la fecha, ésta aparece delante del pie de página. La hora lo hace en el 2º renglón. Ambas se pueden colocar donde se quiera con ctrl+x y ctrl+v. Elijo poner ambas en la 2ª línea, centrándolas con el menú contextual automático flotante. Lo malo es que si se marca actualizar automáticamente, se vuelve a colocar delante del pié de página.
Los márgenes laterales 332896del encabezado y el pie 10de página se pueden ampliar mediante sangrías hacia el borde izq. No hacia el dcho. Sí se pueden achicar hacia ambos lados.


ALERGIAS ......: Dermatologica

MOTIVO CONSULTA .-
Revision.-

POLO ANTERIOR .-
Sin anomalias.

TRATAMIENTO .-
- Cusimolol 0.25% - Azopt colirio
- ----- -
_________________________________________________________________
FIN DEL FICHERO: H0012008.MH1 - 1879 b. - 27/12/2009 - 20:35:13.

3.- CFGAYUDA.001
2.50
S
5.00
0.80
N
N
2
N
5.00
S
S
15
S

Y AHORA WOCAYUDA.PRG:
EN TRES PARTES PARA QUE QUEPA ENTERO.

PARTE PRIMERA:
// Managing Windows trees
// WOCAYUDA.PRG - JULIO 2008. POR FIN !!!!

#include "FiveWin.ch"
#include "Fget.ch"
#include "Splitter.ch"
#include "GTF.ch"
#include "ribbon.ch"
#include "xbrowse.ch"

#define FW_NORMAL 400
#define FW_BOLD 700

//Static oWnd, oGet, oMenu, oFont, nItem, aFiles, oMsgItem, cFileDisc := "", lFile := .f., lHelp := .t.
//Static cText, cFile, nVez, cTit, lIt, nX, lChange := .f., cTextFormat := ""
//static cTextFind := "", CFGAYUDA, bFnt, nAH := 1, nAV := 1, nPar := 1

//static oClp, oPrn, oFonSpec, lFile2 := .f.
static nIndex := 1
static nAvance := 1

static aBmp := {}

static aResources := {}

Static oWnd, oGet, oMenu, oFont, nColor, nItem, aFiles, oMsgItem, cFileDisc := "", lFile := .f., lHelp := .t.
Static cText, cFile, nVez, cTit, lIt, nX, lChange := .f., lAct := .f., cTextFormat := "", lPrev := .f., lPrevIni := .f., bPrev
static cTextFind := "", CFGAYUDA, bFnt, nAH := 1, nAV := 1, nPar := 1, lJustif := .f.

static oPegar, oClp, oPrn, oFonSpec, lFile2 := .f., lPrime := .t., lMembr := .t.

// Variables propias imprescindibles en todos los fuentes
static mNombre := '', cFileTemp, oRBar
static mHistoria:= '', cExt, nVal, cFConf
static mPrimero := 0
static multimo := 0
static mFechaNaci
static mfechaulti
static Date
static a10 := '', cFAcro := ""
static oBrush := ''
//atic FileHelp := ''
static SetAyuda := 0, Act2, cNamepre
static lMotivo := .f., lFin := .f., lCuart := .t., l2007 := .f., lFinImp := .f., oDlg, oDlg2
//static oMenu, oMenuConsulta
static nNivelacc:= 1, nKm
static nUsuario := 1
static cTitular := '', cValW := ""
static contaajeno := ''
static cEleccion:= '', cTextMem := ""
static lChek := .f., lPonerF := .t., lRespaldo
static lText := .f., lBmp := .f., lAvisos := .t., lAcro := .t., lSintax := .t., nSalto := 15, lCinta := .f. //.t.
static oRefr, oTono
static ColorDlg
static ColorTxt
static sClave := '', nLong
static membr0, membr1, membr2
STatic xR
STatic xC
STatic xBV
STatic xBH
Static lMetaf, lColor := .t.
//static nXpR := 0.869, nXpC := 1.30 //1.34 // Correccion Says
//static nXtR := 0.89 , nXtC := 1 // Correccion botones
//static nXkR := 1.483 , nXkC := 1 //0.9 // Correccion lCheck
//static nXpR := 0.862, nXpC := 1.34 // Correccion Says
//static nXtR := 0.67 , nXtC := 1.1 // Correccion botones
//static nXtR := 0.66 , nXtC := 1.16 // Correccion botones
static nXpR := 1.33, nXpC := 1.32 //1.34 // Correccion Says
static nXtR := 1.6 , nXtC := 1.01 // Correccion botones
static nXkR := 1.55 , nXkC := 1.19 //0.9 // Correccion lCheck
static nXLR := 1.6 , nXLC := 1 //0.9 // Correccion label
static nXGR := 1.53 , nXGC := 1 //0.9 // Correccion get

//----------------------------------------------------------------------------//
// lHelp y lFile dirigen el flujo segun sea llamada a ayudas o a formatear anteced/historias
FUNCTION MAIN( cPar )
local oTree, bMasMeno
local oBar, oItem, oItem1, oItem2, oBmp1, oBmp2, oImageList, oSplit, oComo, oTxt, wOk, bComo, lG32 := .f.
local oItem3, oItem4, aItems := Array( 50 ), bResize, cTLee, oBrush, bLee2, cLee2, nOpc := 3, lSalir := .f.
local aCoors, cFCoors, cMemoCoors, oItem5, oItem6, oItem7, oIco, cFileDest := "", oHand
local aFon := Array( 14 ), nColor := 0, bFont, cFon, bParamFont, bNoFormat, bNoFormat2
local lVacio := ( Empty( cPar ) ), nI := 2, cIt := '', cUs := "", oLine, oLetras, oMLetras, cVar := ""
local bExpand, bCollaps, cTx := "Arial", bReset, lSS := .t., nHSPl := 4, lFile3 := .f., nVacio := 2
local cAyd := "", lRecursiva := .f., cMemo := "", cFileNw := "", aVal, lExit := .t.
local nMargen, nFactor, nFilaIni, bSavd, nMargend := 3 //, lSintax := .t., lAcro := .t.
local bIt, FLbxColr, FlbxFont, aTypes, bColrLoad, bFntLoad

//local oRBar
// local oWnd, oMenu
local oGr, oGr1, oGr2, oGr3, oGr4, oMenu
local oBtn, oBtn1, oBtn2, oBtn3, oBtn4, oBtn5
local oBtn6, oBtn7, oBtn8, oBtn9, oBtn10
local oBtn11, oBtn12, oBtn13, oBtn14, oBtn15
local oBtn16, oBtn17, oBtn18, oBtn19, oBtn20
local oBtn21, oBtn22, oBtn23, oBtn24, oBtn25
local oBtn26, oBtn27, oBtn28, oBtn29, oBtn30
local oBtn31, oBtn32, oBtn33, oBtn34, oBtn35
local oSay1, oChk1, lVal1 := .T.
local oTBtn0, oTBtn1, oTBtn2, oTBtn3, oTBtn4, oTBtn5, oTBtn6, oTBtn7
local aClrMenu1 := { { 0.5, RGB( 69, 124, 188 ), RGB( 41, 93, 171 ) }, ;
{ 0.5, RGB( 26, 64, 136 ), RGB( 56, 135, 191 ) } }
local aClrMenu2 := { { 0.5, RGB( 123, 178, 236 ), RGB( 71, 126, 205 ) }, ;
{ 0.5, RGB( 17, 78, 175 ), RGB( 128, 225, 255 ) } }

menu oMenu Popup 2007

menuitem "Stilos" FILE "..\bitmaps\styleset161.BMP"
menuitem "Colores"
menuitem "Fuentes"

endmenu

MENU oMLetras POPUP 2007
MENUITEM "Poner en mayúsculas el texto seleccionado." ACTION ( Seleccion( 1 ), oGet:SetFocus() )
MENUITEM "Poner en minúsculas el texto seleccionado." ACTION ( Seleccion( 2 ), oGet:SetFocus() )
SEPARATOR
MENUITEM ".. en minúsculas, sintáxis y acrónimos." ACTION ( Seleccion( 3 ), oGet:SetFocus() )
//MENUITEM ".. solo aplicar lista de acrónimos" ACTION ( Seleccion( 7 ), oGet:SetFocus() ) // Fatal
//MENUITEM "A mays. solo un formato." ACTION ( Seleccion( 4 ), oGet:SetFocus() )
//MENUITEM "A mins. solo un formato." ACTION ( Seleccion( 5 ), oGet:SetFocus() )
/*
MENUITEM "Reiniciar el documento sin formatos." ACTION ( ; //Seleccion( 6, oFont, nColor ), oGet:SetFocus() )
cText := GTFToTxt( cText ), MemoWrit( aFiles[ nItem ], cText ), ;
iif( at( cTextFormat, cText ) = 0, (Eval( bFnt ), cText := TxtToGTF( cText, , oFont, nColor ),;
MemoWrit( cFileDisc, cText )), Nil ), aFiles[1] := cFileDisc, cTit := "Wocul3.Exe - " + cFileDisc,;


oGet:cText( cText ), oGet:Refresh(), oWnd:SetText( cTit ), oWnd:Refresh() )
*/
// MENUITEM "Salir" ACTION ( oGet:SetFocus() )
ENDMENU





nColor := 0
SET _3DLOOK ON
SET DATE BRITISH
SET CENTURY ON
SET MULTIPLE ON

bSavd := {|| MemoWrit( CFGAYUDA, Str( aVal[1], 5, 2 ) + CRLF + ;
iif( aVal[2] == .t., "S", "N" ) + CRLF + ;
Str( aVal[3], 5, 2 ) + CRLF + ;
Str( aVal[4], 5, 2 ) + CRLF + ;
iif( aVal[5] == .t., "S", "N" ) + CRLF + ;
iif( aVal[6] == .t., "S", "N" ) + CRLF + ;
Str( aVal[7], 1 ) + CRLF + ;
iif( aVal[8] == .t., "S", "N" ) + CRLF + ;
Str( aVal[9], 5, 2 ) + CRLF + ;
iif( aVal[10] == .t., "S", "N" ) + CRLF + ;
iif( aVal[11] == .t., "S", "N" ) + CRLF + ;
Str( aVal[12], 5 ) + CRLF + ;
iif( aVal[13] == .t., "S", "N" ) ) }

CFGAYUDA := "CFGAYUDA.001" // Para Antonio Linares
cMemo := MemoRead( CFGAYUDA )
if Empty( cMemo ) // Omisión
aVal := { 3, .t., 5, 0.80, .f., .f., 2, lCuart, 5, .t., .t., 15, .f. }
Eval( bSavd )
endif

if Empty( cPar )
lVacio := .t.
nFilaIni := Val( AllTrim( memoLine( cMemo, , 1 ) ) )
lPrev := ( AllTrim( memoLine( cMemo, , 2 ) ) == "S" )
nMargen := Val( AllTrim( memoLine( cMemo, , 3 ) ) )
nFactor := Val( AllTrim( memoLine( cMemo, , 4 ) ) )
nFactor := Max( nFactor, 0.20 )
lPrevIni := ( AllTrim( memoLine( cMemo, , 5 ) ) == "S" )
lMembr := ( AllTrim( memoLine( cMemo, , 6 ) ) == "S" )
nVacio := Val( AllTrim( memoLine( cMemo, , 7 ) ) )
nVacio := iif( nVacio < 1, 2, nVacio )
lCuart := ( AllTrim( memoLine( cMemo, , 8 ) ) == "S" )
nMargend := Val( AllTrim( memoLine( cMemo, , 9 ) ) )
lSintax := ( AllTrim( memoLine( cMemo, , 10 ) ) == "S" )
lAcro := ( AllTrim( memoLine( cMemo, , 11 ) ) == "S" )
nSalto := Val( AllTrim( memoLine( cMemo, , 12 ) ) )
lJustif := ( AllTrim( memoLine( cMemo, , 13 ) ) == "S" )

if File( "PACIENTE.DBF" )
nVacio := MenuRadio( "¿Que desea hacer?", { "Ver las Ayudas del programa.", ;
"Formatear un Fichero de Texto.", "Cancelar." }, "WOCAYUDA.EXE va a abrirse", nVacio )
else
nVacio := 2 // Si está fuera de carpeta Ocul no hay q abrir ayudas
endif

aVal := { nFilaIni, lPrev, nMargen, nFactor, lPrevIni, lMembr, nVacio, lCuart, nMargend, lSintax, lAcro, nSalto, lJustif }
Eval( bSavd )
nVacio := 2 // Se pone así para enviar a Antonio Linares
do case // nvacio es un valor de aVal de configuracion
case nvacio == 0
return nil
case nvacio == 1
cPar := ""
case nvacio == 2
lFile3 := .t.
lPrevIni := .f.
cPar := "NUEVO.TXT_1_0"
MemoWrit( "NUEVO.TXT", "" )
case nvacio == 3
return Nil
endcase

Endif

cTextFormat := FORMAT_TEXT_TYPE + SP_REG + ;
FORMAT_TEXT_VERSION + SP_FIELD

// lFile := ( at( ".ED", cValToChar(cPar) ) > 0 ) .or. ( at( ".MH", cValToChar(cPar) ) ) > 0
lFile := ( at( ".\SV", Upper( cValToChar(cPar) ) ) > 0 ) .or. ;
( at( ".\AUT", Upper( cValToChar(cPar) ) ) > 0 ) .or. ;
( at( ".ALS", Upper( cValToChar(cPar) ) ) > 0 ) .or. ;
( at( ".RED", Upper( cValToChar(cPar) ) ) > 0 ) .or. ;
( at( ".MH", cValToChar(cPar) ) > 0 ) .or. ( Upper(cValToChar( cPar ) ) ==

"AYUDA.WLP" )
lFile2 := ( at( ".MH", cValToChar(cPar) ) > 0 ) // Las historias vienen ya creadas en Ansi y asi se guardan
lHelp := !(lFile)
//lCinta := lFile .or. lFile2
cAyd := "CONSEJOS INICIALES EN TEXTOS CON FORMATO. " + CRLF + ;
iif( lHelp, ;
"Doble Click sobre en cualquier Item abre el texto," + CRLF + ;
"incluso en los principales. " + CRLF, "" ) + ;
"Primero seleccione TODO el texto y elija FUENTE (Nombre y tamaño)" + CRLF + ;
"y color, y luego seleccione las palabras o líneas que desee destacar" + CRLF + ;
"cambiando su color, fuente o alineación.. " + CRLF + ;
"Es preciso elegir nombre de la fuente ( P.ej.: Arial, tamaño 12, Negrita )" + CRLF + ;
"Si no lo haces así se imprimen mal. " + CRLF + ;
"Para que se imprima bien pon el ancho de la ventana al tamaño de un" + CRLF + ;
"folio menos 3 o 4 cm, para que las líneas salgan enteras y " + CRLF + ;
"compruebalo en previsualización antes de imprimir. " + CRLF + ;
iif( lHelp, "El botón <Reset> establece las coordenadas aproximadas óptimas" + CRLF + ;
"de la ventana para imprimir bien. " + CRLF, ;
"Modificando del ancho de la ventana y previsualizando impreso " + CRLF + ;
"controlas para un buen impreso. " ) + CRLF + ;
"Puedes hacer cambios, imprimir y luego salir y no archivar los cambios," + CRLF + ;
"p.ej., tras usar los protocolos o tratamientos automáticos.. " + CRLF + ;
"Puedes configurar la impresión: Previsualizar y aplicar factores y margenes. "
//"NO IMPRIMAS desde la opción <print> del menú contextual: VA a salir MAL. "
if ( Upper(cValToChar( cPar ) ) == "AYUDA.WLP" )
cAyd := StrTran( cAyd, CRLF, ' ' )
cAyd := StrTran( cAyd, '. ', '.' + CRLF + CRLF )
MemoWrit( "AYUDA.WLP", cAyd )
lRecursiva := .t.
endif

cUs := iif( (lFile) .and. at( "_", cValToChar(cPar) ) > 0, ;
SubsTr( cValToChar(cPar), at( "_", cValToChar(cPar) )+1 ), cUs )
cVar := cUs
cUs := iif( (lFile) .and. at( "_", cValToChar(cUs) ) > 0, ;
SubsTr( cValToChar(cUs), 1, at( "_", cValToChar(cUs) )-1 ), cUs )
nUsuario := Val( cUs )

cVar := iif( (lFile) .and. at( "_", cValToChar(cVar) ) > 0, ;
SubsTr( cValToChar(cVar), at( "_", cValToChar(cVar) )+1 ), cVar )

mNombre := iif( (lFile) .and. at( "_", cValToChar(cVar) ) > 0, ;
SubsTr( cValToChar(cVar), 1, at( "_", cValToChar(cVar) )-1 ), cVar )

cVar := iif( (lFile) .and. at( "_", cValToChar(cVar) ) > 0, ;
SubsTr( cValToChar(cVar), at( "_", cValToChar(cVar) )+1 ), cVar )

FLbxFont := iif( (lFile) .and. at( "_", cValToChar(cVar) ) > 0, ;
SubsTr( cValToChar(cVar), 1, at( "_", cValToChar(cVar) )-1 ), cVar )

cVar := iif( (lFile) .and. at( "_", cValToChar(cVar) ) > 0, ;
SubsTr( cValToChar(cVar), at( "_", cValToChar(cVar) )+1 ), cVar )

FLbxColr := iif( (lFile) .and. at( "_", cValToChar(cVar) ) > 0, ;
SubsTr( cValToChar(cVar), 1, at( "_", cValToChar(cVar) )-1 ), cVar )

mNombre := Val( mNombre )
IF File( "PACIENTE.DBF" )
if mNombre > 0
DbUseArea( .t., , "Paciente", , .t. ) // modo compartido
if mNombre <= Paciente->( LastRec() )
Paciente->( DbGoto( mNombre ) )
mNombre := OemToAnsi( Paciente->Nombre )
endif
Paciente->( DbCloseArea() )
endif
else
// ""
ENDIF

//nUsuario := iif( (lFile) .and. at( "_", cValToChar(cPar) ) > 0, ;
// Val( Trim( SubsTr(

cValToChar(cPar), at( "_", cValToChar(cPar) )+1 ) ) ), nUsuario )
nUsuario := iif( nUsuario > 0, nUsuario, 1 ) // Evitar errores

cExt := PADL( AllTrim( str( nUsuario, 3 ) ), 3, "0" )
cFConf := "CONFIGUR." + cExt
cValW := Trim( MemoRead( cFConf ) ) + Space( 200 )
nVal := Val( SubsTr( cValW, 1, 1 ) )

if lFile
if at( "_", cPar ) > 0
cPar := SubsTr( cPar, 1, at( "_", cPar )-1 )
endif
endif

CFGAYUDA := "CFGAYUDA.001" // para enviar a Antonio Linares
bPrev := {|| ;
cMemo := MemoRead( CFGAYUDA ),;
nFilaIni := Val( AllTrim( memoLine( cMemo, , 1 ) ) ) ,;
lPrev := ( AllTrim( memoLine( cMemo, , 2 ) ) == "S" ),;
nMargen := Val( AllTrim( memoLine( cMemo, , 3 ) ) ),;
nFactor := Val( AllTrim( memoLine( cMemo, , 4 ) ) ),;
nFactor := Max( nFactor, 0.20 ),;
lPrevIni := ( AllTrim( memoLine( cMemo, , 5 ) ) == "S" ) .and. !( lVacio ),;
lPrevIni := iif( Upper(cValToChar( cPar ) ) == "AYUDA.WLP", .f., lPrevIni ), ;
lMembr := ( AllTrim( memoLine( cMemo, , 6 ) ) == "S" ) ,;
nVacio := Val( AllTrim( memoLine( cMemo, , 7 ) ) ),;
lCuart := ( AllTrim( memoLine( cMemo, , 8 ) ) == "S" ) ,;
nMargend := Val( AllTrim( memoLine( cMemo, , 9 ) ) ), ;
lSintax := ( AllTrim( memoLine( cMemo, , 10 ) ) == "S" ),;
lAcro := ( AllTrim( memoLine( cMemo, , 11 ) ) == "S" ),;
nSalto := Val( AllTrim( memoLine( cMemo, , 12 ) ) ),;
lJustif := ( AllTrim( memoLine( cMemo, , 13 ) ) == "S" ) }

Eval( bPrev )
nVacio := 2 // para enviar a Antonio Linares
bNoFormat := {| n | lSS := .f., ;
iif( MsgYesNo( "( Aconsejable Salvar antes .. ) - ¿SEGURO de ELIMINAR Formato?.", ;
"Eliminar el formateado de TODOS los FICHEROS." ), ( ;
aEval( aFiles, {| c, n | cTLee := MemoRead( aFiles[ n ] ),;
iif( at( cTextFormat, cTLee ) > 0, ( cTLee := GTFToTxt( cTLee ), ; //GTFToTxt
MemoWrit( aFiles[ n ], cTLee ), cTLee :=

"" ), Nil ) } ), ;
iif( MsgYesNo( "¿Cerrar la Aplicación?.",

"Seleccionar una opción" ), oWnd:End(), ;
( cText := MemoRead( aFiles[ n ] ), Eval(

bFnt ), cText := TxtToGTF( cText, , oFont, nColor ), ;
oGet:cText( cText ), oGet:Refresh( ),

MemoWrit( aFiles[ n ], cText ) ) ) ), Nil ) }



bNoFormat2 := {| n | ;
iif( MsgYesNo( "¿SEGURO de ELIMINAR Formato?.", ;
"Eliminar el formateado del FICHERO ACTUAL." ), ;
iif( at( cTextFormat, cText ) > 0, ;
( cTexT := GTFToTxt( cText ), MemoWrit( aFiles[ n ], iif( lFile, AnsiToOem( cText ), cText ) ), lChange := .f. ), ;
MsgInfo( "No está Formateado..", aFiles[ n ] ) ), Nil ) }

SetBalloon( .t. ) // Los tooltips de globo de 2007

aFiles := Array( 50 )
nItem := 1
nX := 0
lIt := .f.

cTit := "WOCUL3.EXE - ARBOL de Ayudas. " + FWVERSION

nPar := iif( !Empty( cPar ), Val( AllTrim( cPar ) ), nPar )
nPar := iif( nPar < 1, 1, nPar )
nI := iif( nPar < 17, 1, nI )
cPar := iif( cPar == Nil, "1", cPar )
bIt := {|| cFileDisc := aItems[ nPar ] }
bIt := {|| nItem := nPar, cFileDisc := aFiles[ nPar ] } // Mejor así ???? 25-08-2009
nItem := nPar

lChange := .f.
nVez := 1
cText := " " //Memoread( aFiles[ nItem ] )
cFile := " "

AFill( aItems, Space( 10 ) )
AFill( aFiles, Space( 10 ) )

// adaptar a llamada de no ayuda sino los SV.. /historias
if (lFile)
aFiles := {}
aadd( aFiles, cPar )
nItem := nPar := 1
cTit := "Wocul3.Exe - Textos con Formato: " + cPar
cText := Memoread( aFiles[ nItem ] )
endif

bReSize := {|| iif( lHelp, ;
( oGet:nTop := oSplit:nTop + 1, oGet:nLeft := oSplit:nLeft + 5 ), ;
( oGet:nTop := iif( lCinta, 140, 29 ), oGet:nLeft := 38 ) ), ;
oGet:SetSize( oWnd:nWidth() - ( 20 + iif( lHelp, oSplit:nLeft, 70 ) ),;
oWnd:nHeight() - iif( lHelp, iif( lCinta, 200, 110 ), iif( lCinta, 205, 110 ) ) ), SysRefresh() }
//120, 150
aCoors := { 2, 11, 45, 97 }
//aCoors := { 2, 11, 45, 132 }

cFCoors := 'Coords.Dat' // a partir de aqui se denominara cada ventana
if Empty( Memoread( cFCoors ) )
MemoWrit( 'Coords.Dat', Str( aCoors[ 1 ], 10, 2 ) + CRLF + ;
Str( aCoors[ 2 ], 10, 2 ) + CRLF + Str( aCoors[ 3 ], 10, 2 ) + CRLF + ;
Str( aCoors[ 4 ], 10, 2 ) )
endif

// Corrige coords con relacion a las de creacion
bReset := {|| ; //Actual() nAH := nAH/1280, nAV := nAV/800, ;
aCoors := { 2, 11, 45*nAV, 97*nAH }, ;
aCoors[1]*= 16, aCoors[2]*= 8,;
aCoors[3]*= 16, aCoors[4]*= 8, ;
oWnd:SetBounds( aCoors[2], aCoors[1], aCoors[4], aCoors[3] ), ;
oWnd:Refresh(), Eval( oWnd:bResized ), oWnd:ReFresh() }

// nLeft, nTop, nRight, nBottom
if lFile .and. Upper( Substr( cPar, 1, 4 ) ) == ".\SV" // Crata receta escrito
if !File( "TCoords.Dat" )
MemoWrit( "TCoords.Dat", "6.31" + CRLF + "37.25" + CRLF + "33.24" + CRLF + "107.04" )
endif
cFCoors := 'TCoords.Dat'
cMemoCoors := MemoRead( 'TCoords.Dat' )
else
cMemoCoors := MemoRead( 'Coords.Dat' ) // cFCoors por omisión
endif
aCoors[ 1 ] := Val( TRIM( Memoline( cMemoCoors,, 1 ) ) )
aCoors[ 2 ] := Val( TRIM( Memoline( cMemoCoors,, 2 ) ) )
aCoors[ 3 ] := Val( TRIM( Memoline( cMemoCoors,, 3 ) ) )
aCoors[ 4 ] := Val( TRIM( Memoline( cMemoCoors,, 4 ) ) )
// Correcciones..
aCoors[ 3 ] := iif( aCoors[ 3 ] < aCoors[ 1 ], aCoors[ 1 ] + 20, aCoors[ 3 ])
aCoors[ 4 ] := iif( aCoors[ 4 ] < aCoors[ 2 ], aCoors[ 2 ] + 20, aCoors[ 4 ])

lG32 := ( File( GetWinDir() + "\RunDll32.exe" ) .or. File( GetSysDir() + "\RunDll32.exe" ) ) .or. ;
( File( GetWinDir() + "\RunDlg32.exe" )

.or. File( GetSysDir() + "\RunDlg32.exe" ) )

bComo := {| cX | iif( lG32, ;
cFileDest := cGetFile32( cFileName( cFileDisc ) + ;
cX + ;
"Todos ( *.* ) | *.* ", ;
"Elija Destino y Nombre", 01, ".\", .t., .t., cFileDisc ), ;
cFileDisc := cGetFile( cFileName( cFileDisc ) + ;
cX + ;
"Todos ( *.* ) | *.* ", ;
"Elija Destino y Nombre", 01, ".\", .t., .t., cFileDisc ) ),;
MemoWrit( cFileDest, iif( at( "Formateado", cX ) > 0, cText, ;
iif( lFile, AnsiToOem( GTFToTxt( cText ) ), GTFToTxt( cText ) ) ) ), lChange := .f. }
lHelp := .f. // para Antonio Linares
lFile := .t. ; lFile2 := .t. // Para Antonio Linares
if lHelp .or. !( lCinta )
MENU oMenu 2007

MENUITEM "Archivo"
MENU
if lFile .or. lFile2 .or. lFile3 // Para Antonio Linares

MENUITEM "&Nuevo" ACTION ( ;
cFileDisc := "Nuevo.Txt", cText := "Nuevo.. ", ;
MemoWrit( cFileDisc, cText ), ;
cText := MemoRead( cFileDisc ), cText := iif( IsOem( cText ), OemToAnsi( cText ), cText ),;
iif( at( cTextFormat, cText ) = 0, (Eval( bFnt ), cText := TxtToGTF( cText, , oFont, nColor ),;
MemoWrit( cFileDisc, cText )), Nil ), aFiles[1] := cFileDisc, cTit := "Wocul3.Exe - " + cFileDisc,;


oGet:cText( cText ), oGet:Refresh(), oWnd:SetText( cTit ), oWnd:Refresh() )

MENUITEM "&Abrir" ACTION ( ;
iif( lG32, ;
cFileNw := cGetFile32( cFileName( cFileDisc ) + ;
"Todos ( *.* ) | *.* ", ;
"Elija Origen y Nombre", 01, ".\", .f., .t., cFileDisc ), ;
cFileNw := cGetFile( cFileName( cFileDisc ) + ;
"Todos ( *.* ) | *.* ", ;
"Elija Origen y Nombre", 01, ".\", .f., .t., cFileDisc ) ), ;
cFileDisc := iif( !Empty( cFileNw ), cFileNw, cFileDisc ), ;
cText := MemoRead( cFileDisc ), cText := iif( IsOem( cText ), OemToAnsi( cText ), cText ),;
iif( at( cTextFormat, cText ) = 0, (Eval( bFnt ), cText := TxtToGTF( cText, , oFont, nColor ),;
MemoWrit( cFileDisc, cText )), Nil ), aFiles[1] := cFileDisc, cTit := "Wocul3.Exe - " + cFileDisc,;


oGet:cText( cText ), oGet:Refresh(), oWnd:SetText( cTit ), oWnd:Refresh() )

SEPARATOR
endif

MENUITEM "&Guardar Formateado" ACTION Eval( wOk:bAction )
MENUITEM "Salvar en Formato TXT y Salir" ACTION ( cText := GTFToTxt( cText ), lAct := .t., lChange := .f., ;
cText := iif( lFile .and. !lFile2, AnsiToOem( cText ), cText ), MemoWrit( aFiles[ nItem ], cText ), oWnd:End() )

SEPARATOR
MENUITEM oComo PROMPT "Guardar c&omo ..( Formateado)" ACTION ;
Eval( bComo, "(GTF) Texto

Formateado ( *.Wlt ) | *.Wlt | " )
MENUITEM oTxt PROMPT "Guardar COMO en formato TXT" ACTION ( ;
Eval( bComo, "(TXT) Texto sin

Formato ( *.Txt ) | *.Txt | " ) )
SEPARATOR
MENUITEM "&Salir" ACTION oWnd:End()
ENDMENU

MENUITEM "&Editar" ACTION ;
ShowP( 0, 60, oGet )
/*
MENU
MENUITEM "&Deshacer" ACTION ( ;
iif( !(lAct), MsgInfo( "No hay cambios a deshacer", "Deshacer" ), oGet:UnDo() ), ;
lChange := .t. )
SEPARATOR
MENUITEM "Cor&tar" ACTION ( oGet:Cut(), lChange := .t., lAct := .t. )
MENUITEM "&Copiar" ACTION ( oGet:Copy(), lChange := .t., lAct := .t. )
MENUITEM "&Pegar" ACTION ( oGet:Paste(), lChange := .t., lAct := .t. )
MENUITEM "B&orrar" ACTION ( oGet:Del(), lChange := .t., lAct := .t. )
SEPARATOR
MENUITEM "Se&leccionar todo" ACTION oGet:SelectAll()
SEPARATOR
MENUITEM "&Buscar texto" ACTION Find()
MENUITEM "&Siguiente" ACTION FindNext()
ENDMENU

MENUITEM "Archivo"
MENU
MENUITEM "&Guardar" ACTION Eval( wOk:bAction )
MENUITEM "Salvar en Formato TXT y Salir" ACTION ( cText := GTFToTxt( cText ), lAct := .t., lChange := .f., ;
cText := iif( lFile .and. !lFile2, AnsiToOem( cText ), cText ), MemoWrit( aFiles[ nItem ], cText ), oWnd:End() )

SEPARATOR
MENUITEM oComo PROMPT "Guardar c&omo .." ACTION ;
Eval( bComo, "(GTF) Texto

Formateado ( *.Wlt ) | *.Wlt | " )
MENUITEM oTxt PROMPT "Guardar COMO en formato TXT" ACTION ( ;
Eval( bComo, "(TXT) Texto sin

Formato ( *.Txt ) | *.Txt | " ) )
SEPARATOR
MENUITEM "&Salir" ACTION oWnd:End()
ENDMENU

MENUITEM "Fuentes"
MENU
MENUITEM "&Color" ACTION ( oGet:GetColor(), lChange := .t., lAct := .t. )
MENUITEM "&Fuente" ACTION ( oGet:GetFontColor(), lChange := .t., lAct := .t. )
// SEPARATOR
// MENUITEM "Eliminar Formateado.."
// MENU
// MENUITEM "Todos los Ficheros" ACTION Eval( bNoFormat, nItem )
// MENUITEM "Fichero actual" ACTION Eval( bNoFormat2, nItem )
// MENUITEM "Pasar a Formato Txt y Salir" ACTION Eval( bNoFormat2, nItem )
// ENDMENU
ENDMENU
MENUITEM "Alinear"
MENU
MENUITEM "Alinear a la Izquierda" ACTION ( oGet:SetAlign( ES_LEFT ), lChange := .t., lAct := .t. ) //MemoWrit( aFiles[

nItem ], cText ))
MENUITEM "Alinear a la Derecha" ACTION ( oGet:SetAlign( ES_RIGHT ), lChange := .t.,lAct := .t. ) //,MemoWrit(

aFiles[ nItem ],cText ))
MENUITEM "Centrada" ACTION ( oGet:SetAlign( ES_CENTER ), lChange := .t., lAct := .t. ) //,MemoWrit( aFiles[

nItem ], cText ))
// MENUITEM "Justificar" ACTION ( oLine := oGet:oLine, oGet:GetDC(), ;
// oGet:LineAdjust( oGet:oLineInit, oGet:oLineEnd ) ) // MemoWrit( aFiles[ nItem ], cText ))
//? oGet:WidthLine( oLine ), Eval( oGet:nWidth )
ENDMENU
*/
MENUITEM "Textos"
MENU
MENUITEM "Ir a número de Línea" ACTION GoLine()
MENUITEM "Informe de la Línea actual" ACTION Information()
SEPARATOR
MENUITEM "&Buscar texto" ACTION Find()
MENUITEM "Texto siguiente" ACTION FindNext()
SEPARATOR
MENUITEM "Guar&dar Documento" ACTION ( MemoWrit( aFiles[ nItem ], cText ), lChange := .f. )
MENUITEM "&Imprimir Documento" ACTION Imprimir( oGet, aFiles[ nItem ] )
// SEPARATOR
ENDMENU

MENUITEM "&Salir" ACTION oWnd:End() //( MemoWrit( aFiles[ nItem ], cText ), oWnd:End() )
ENDMENU
endif
DEFINE FONT oFont SIZE 0, -10 OF oWnd

bFnt := {||;
aFon := { -14, 0, 0, 0, 700, .t., .f., .f., 0, 0, 0, 0, 0, 'Arial' },;
Eval( bParamFont ) }

bParamFont := {|| iif( !Empty( aFon ), ( ;
iif( !Empty( oFont ), oFont:End(), Nil ), ;
oFont := TFont():New( aFon[14],;
aFon[02], aFon[01], .f., ;
! ( aFon[05] == 400 ), aFon[03], ;
aFon[04], aFon[05], ;
aFon[06], aFon[07], ;
aFon[08], aFon[09], ;
aFon[10], aFon[11], ;
aFon[12] ) ), MsgStop( 'Font NO Creado !..' ) ) }


if lFile
FLbxColr := iif( !File( FLbxColr), 'FWMECOLR.' + cExt, FLbxColr )
FLbxFont := iif( !File( FLbxFont), 'FWMEFONT.' + cExt, FLbxFont )
bColrLoad:= {|| nColor := Val( AllTrim( Memoread( FLbxColr ) ) ) }
Eval( bColrLoad )

//FLbxFont := 'FWMEFONT.' + cExt

aTypes := { -14, 0, 0, 0, 700, .t., .f., .f., 0, 0, 0, 0, 0, 'Arial' }

bFntLoad := {|| cFon := Memoread( FLbxFont ), ;
Iif( MLCount( cFon ) > 0, ;
( aFon := Array( 14 ), ;
aEval( aFon, { | c, n | aFon[n] := AllTrim(Memoline( cFon,, n )), ;
aFon[n] := uCharToVal( AllTrim( aFon[n] ), aTypes[n] ) } ) ), ;
aFon := aTypes ),;
iif( !Empty( aFon ), Eval( bParamFont ), Nil ) }

bFnt := {|| Eval( bFntLoad ) }
Eval( bFnt )
// Se varia el tama¤o

//bMasMeno := {| n | aFon[01] := iif( aFon[01] < 0, -( Abs( aFon[01] ) + ( n ) ), ;
// aFon[01]

+ ( n ) ), aFon[02] := iif( ABS( aFon[02] + ( n/5 ) ) > 2, ;
// aFon[2],

aFon[02] + ( n/5 ) ) , aFon[04] := 0, ;
// Eval( bFntSave ), Eval( bFntLoad ),;
// oGet:SetFont( oFonBot ), ;
// SysRefresh() }

else
bFnt := {||;
aFon := { -14, 0, 0, 0, 700, .t., .f., .f., 0, 0, 0, 0, 0, 'Arial' },;
Eval( bParamFont ) }
endif

DEFINE ICON oIco FILE "WOCUL3.ico"

DEFINE WINDOW oWnd FROM aCoors[1], aCoors[2] TO aCoors[3], aCoors[4] ;
TITLE cTit ICON oIco MENU oMenu // COLOR CLR_GREEN, CLR_WHITE
//oWnd:nClrText := CLR_GREEN
//oWnd:nClrPane:= CLR_GREEN
If lFile
DEFINE BRUSH oBrush COLOR nRGB( 211, 241, 250 )
SET BRUSH OF oWnd TO oBrush
//else
// DEFINE BRUSH oBrush COLOR CLR_WHITE //nRGB( 255, 255, 255 )
endif

DEFINE CURSOR oHand HAND
// lCinta := .t.
IF lHelp .or. !( lCinta )
DEFINE BUTTONBAR oBar OF oWnd 3D 2007 CURSOR oHand

// oBar:bClrGrad = { | lInvert | If( ! lInvert,;
// { { 0.25, nRGB( 178, 187, 202 ), nRGB( 137, 155, 179 ) },;
// { 0.75, nRGB( 129, 149, 174 ), nRGB( 114, 132, 156 ) } },;
// { { 0.25, nRGB( 139, 166, 193 ), nRGB( 69, 119, 170 ) },;
// { 0.75, nRGB( 52, 104, 152 ), nRGB( 50, 107, 162 ) } } ) }

//oBar:nClrText = nRGB( 255, 255, 255 )

//DEFINE BUTTON FILE ".\BITMAPS\wdoc.bmp" OF oBar ACTION
DEFINE BUTTON PROMPT "Ayd" OF oBar ACTION ;
WAITRUN( "WOCAYUDA.EXE AYUDA.WLP", 1 ) ; //MsgInfo( cAyd, "Información" )
TOOLTIP { "Ayuda en esta ventana.", 'Ayuda',, } NOBORDER WHEN !( lRecursiva )

// DEFINE BUTTON FILE ".\BITMAPS\wPrint4.bmp" OF oBar ACTION
DEFINE BUTTON PROMPT "Prn" OF oBar ACTION ;
( Imprimir( oGet, cFileDisc ), cText := MemoRead( cFileDisc ), oGet:cText( cText ), oGet:Refresh() ) TOOLTIP { "El

documento completo", "Imprimir",, }

// DEFINE BUTTON FILE ".\BITMAPS\WCONFIG2.bmp" OF oBar ACTION Configurar()
DEFINE BUTTON PROMPT "Cfg" OF oBar ACTION Configurar() ;
TOOLTIP { "Diálogo de imprimir documento", "Configurar",, }

// DEFINE BUTTON FILE ".\BITMAPS\WRefresh.bmp" OF oBar ACTION Eval( bReset )
DEFINE BUTTON PROMPT "Rst" OF oBar ACTION Eval( bReset ) ;
TOOLTIP { "Coordenadas aproximadas aconsejables para imprimir", "Ventana",, }

if lHelp
DEFINE BUTTON OF oBar GROUP ;
FILE ".\BITMAPS\WEXPAND.BMP" ;
ACTION Eval( bExpand );
TOOLTIP { "Expandir TODO el arbol.", 'Expande',, } NOBORDER

DEFINE BUTTON OF oBar ;
FILE ".\BITMAPS\WCOLLAPS.BMP" ;
ACTION Eval( bCollaps ) ;
TOOLTIP { "Colapsar TODO el arbol.", 'Colapsa',, } NOBORDER
endif

// FILE ".\BITMAPS\CLR.BMP"
DEFINE BUTTON OF oBar GROUP ;
PROMPT "Clr" ;
ACTION ( oGet:GetColor(), lChange := .t., lAct := .t. ) ;
TOOLTIP { "Para el texto seleccionado.", 'Color',, } NOBORDER
// FILE ".\BITMAPS\WFONTS.BMP"
DEFINE BUTTON OF oBar ;
PROMPT "Fnt" ;
ACTION ( oGet:GetFontColor(), lChange := .t., lAct := .t. ) ;
TOOLTIP { "Para el texto seleccionado.", "Font y Color",, } NOBORDER

DEFINE BUTTON OF oBar ;
PROMPT "Und" ; // FILE ".\BITMAPS\UNDO2.BMP"
ACTION ( iif( !(lAct), MsgInfo( "No hay cambios a deshacer", "Deshacer" ), oGet:UnDo() ), ;
lChange := .t. ) ;
TOOLTIP { "Deshacer el último cambio", "Texto",, } NOBORDER //ADJUST

DEFINE BUTTON OF oBar ;
PROMPT "Izq" ; // FILE ".\BITMAPS\TextAlignleft16.Bmp" //IZQUIERD.BMP"
ACTION ( oGet:SetAlign( ES_LEFT ), lChange := .t., lAct := .t. ) ;
TOOLTIP { "A la Izquierda.", "Alinear",, } NOBORDER //ADJUST

DEFINE BUTTON OF oBar ;
PROMPT "Ctr" ; // FILE ".\BITMAPS\TextAligncenter16.Bmp" //CENTRAR.BMP"
ACTION ( oGet:SetAlign( ES_CENTER ), lChange := .t., lAct := .t. ) ;
TOOLTIP { "El texto seleccionado.", "Centrar",, } NOBORDER //ADJUST

DEFINE BUTTON OF oBar ;
PROMPT "Dch" ; // FILE ".\BITMAPS\TextAlignright16.Bmp" //DERECHA.BMP"
ACTION ( oGet:SetAlign( ES_RIGHT ), lChange := .t., lAct := .t. ) ;
TOOLTIP { "A la derecha.", "Alinear",, } NOBORDER //ADJUST

// DEFINE BUTTON OF oBar ;
// FILE ".\BITMAPS\TextAlignjustify16.Bmp" ; //DERECHA.BMP"
// ACTION ( cFileTemp := cFileNoExt( cFileDisc ) + ". Temp", Memowrit( cFileTemp, cText ), ;
// Justify( oGet ), lChange := .t., lAct := .t. ) ;
// TOOLTIP { "Justificado.", "Alinear",, } NOBORDER //ADJUST

// MENU oMLetras POPUP 2007
// MENUITEM "Poner en mayúsculas el texto seleccionado." ACTION ( Seleccion( 1 ), oGet:SetFocus() )
// MENUITEM "Poner en minúsculas el texto seleccionado." ACTION ( Seleccion( 2 ), oGet:SetFocus() )
// SEPARATOR
// MENUITEM ".. en minúsculas, sintáxis y acrónimos." ACTION ( Seleccion( 3 ), oGet:SetFocus() )
//MENUITEM ".. solo aplicar lista de acrónimos" ACTION ( Seleccion( 7 ), oGet:SetFocus() ) // Fatal
//MENUITEM "A mays. solo un formato." ACTION ( Seleccion( 4 ), oGet:SetFocus() )
//MENUITEM "A mins. solo un formato." ACTION ( Seleccion( 5 ), oGet:SetFocus() )
// MENUITEM "Reiniciar documento: Sin formatos." ACTION ;
// ( Eval( bComo, "(TXT) Texto sin Formato ( *.Txt ) | *.Txt | " ), cText := MemoRead( cFileDisc ), ;
// cText := TxtToGTF(), oGet:SetFocus() )
// MENUITEM "Salir" ACTION ( oGet:SetFocus() )
// ENDMENU

DEFINE BUTTON oLetras OF oBar ;
PROMPT "Mm" ; // FILE ".\BITMAPS\Mm.BMP"
ACTION ( oLetras:ShowPopup() ) ; //MsgInfo( "En gestión", "Aún no disponible" ), lChange := .t., lAct := .t. )
TOOLTIP { "Cambiar: Mayúsculas / minúsculas", "Texto seleccionado",, } NOBORDER ;
MENU oMLetras

DEFINE BUTTON OF oBar GROUP ;
PROMPT "Ir" ; //FILE ".\BITMAPS\THIS.BMP"
ACTION GoLine() ;
TOOLTIP { "Ir a una Línea.", "Número",, } NOBORDER //ADJUST

DEFINE BUTTON OF oBar ;
PROMPT "Fnd" ; // FILE ".\BITMAPS\WFIND.BMP"
ACTION Find() ;
TOOLTIP { "Buscar en el escrito.", "Texto EXACTO (Mm)",, } NOBORDER //ADJUST

DEFINE BUTTON OF oBar ;
PROMPT "Nex" ; // FILE ".\BITMAPS\WNEXT.BMP"
ACTION FindNext() ;
TOOLTIP { "Buscar el siguiente.", "Texto",, } NOBORDER //ADJUST

DEFINE BUTTON wOk OF oBar GROUP ;
PROMPT "Sav" ; // FILE ".\BITMAPS\WOK.BMP"
ACTION( MemoWrit( cFileDisc, cText ), ;
MsgWait( "Texto y Formato guardados .." , cFileDisc, 0.8 ), lChange := .f. ) ;
TOOLTIP { "Guardar modificaciones.", "Texto y Formato",, } NOBORDER //ADJUST

DEFINE BUTTON OF oBar ;
PROMPT "Cop" ; // FILE ".\BITMAPS\BCOPY3.BMP"
ACTION ( nOpc := Alert( cFileDisc + " - Guardar Como.. ", ;
{ '&Texto Formateado', 'Texto &Sin Formato', '&Cancelar' }, "Seleccione una Opción..", 3 ),; //

".\BITMAPS\BCOPY3.BMP" )
nOpc := iif( nOpc == 0, 3, nOpc ), iif( nOpc == 1, Eval( oComo:bAction ), ;
iif( nOpc == 2, Eval( oTxt:bAction ), MsgWait( "Saliendo sin acción..", "Guardar", 0.7 ) ) ) ) ;
TOOLTIP { "Guardar como ..", "Formato y Texto", , }

DEFINE BUTTON OF oBar ;
PROMPT "Txt" ; // FILE ".\BITMAPS\WEDIT3.BMP"
ACTION ( cText := GTFToTxt( cText ), cText := iif( ( lFile ) .and. !lFile2, AnsiToOem( cText ), cText ), ;
MemoWrit( aFiles[ nItem ], cText ), lChange := .f., oWnd:End() ) ;
TOOLTIP { IIF( lFile, "Salvar en Txt y cerrar..", "Suprimir FORMATO.." ), "Texto actual", , }





DEFINE BUTTON OF oBar GROUP ;
PROMPT "Inf" ; // FILE ".\BITMAPS\WSOURCE.BMP"
ACTION Information() ;
TOOLTIP { "Información de los datos.", "Línea actual",, } NOBORDER //ADJUST

DEFINE BUTTON OF oBar ;
PROMPT "Exit" ; // FILE ".\BITMAPS\WEXIT5.BMP"
ACTION oWnd:End() ; //( iif( lChange, MemoWrit( aFiles[ nItem ], cText ), Nil ), oWnd:End() )
TOOLTIP { "Terminar..", "Aplicación",, } NOBORDER //ADJUST

else

// MENU oMLetras POPUP 2007
// MENUITEM "Poner en mayúsculas el texto seleccionado." ACTION ( Seleccion( 1 ), oGet:SetFocus() )
// MENUITEM "Poner en minúsculas el texto seleccionado." ACTION ( Seleccion( 2 ), oGet:SetFocus() )
// SEPARATOR
// MENUITEM ".. en minúsculas, sintáxis y acrónimos." ACTION ( Seleccion( 3 ), oGet:SetFocus() )
//MENUITEM ".. solo aplicar lista de acrónimos" ACTION ( Seleccion( 7 ), oGet:SetFocus() ) // Fatal
//MENUITEM "A mays. solo un formato." ACTION ( Seleccion( 4 ), oGet:SetFocus() )
//MENUITEM "A mins. solo un formato." ACTION ( Seleccion( 5 ), oGet:SetFocus() )
// MENUITEM "Reiniciar el documento sin formatos." ACTION ( ; //Seleccion( 6, oFont, nColor ), oGet:SetFocus() )
// cText := GTFToTxt( cText ), MemoWrit( aFiles[ nItem ], cText ), ;
// iif( at( cTextFormat, cText ) = 0, (Eval( bFnt ), cText := TxtToGTF( cText, , oFont, nColor ),;
// MemoWrit( cFileDisc, cText )), Nil ), aFiles[1] := cFileDisc, cTit := "Wocul3.Exe - " + cFileDisc,;


// oGet:cText( cText ), oGet:Refresh(), oWnd:SetText( cTit ), oWnd:Refresh() )
// MENUITEM "Salir" ACTION ( oGet:SetFocus() )
// ENDMENU

DEFINE RIBBONBAR oRBar PROMPT "Edición", "Ficheros", "Informes", "Ayudas" ;
HEIGHT 133 TOPMARGIN 25 OF oWnd
oRBar:nLeftMargin = 75
oRBar:CalcPos()

// oTBtn0 = TRBtn():New( 4, 0, 70, 20, ".\bitmaps\rbnmenu.bmp", { || MsgInfo( "action" ) }, oRBar ,;
// ,,,,,, .T., .T.,,,,,, "POPUP", oMenu,,,,,,,,,,,,, aClrMenu1, nRGB( 125, 172, 215 ),;
// nRGB( 65, 106, 189 ) )

oTBtn0 = TRBtn():New( 4, 0, 70, 20, ".\bitmaps\WHelp.bmp", { || WAITRUN( "WOCAYUDA.EXE AYUDA.WLP", 1 ) }, oRBar

,;
,,,,,, .T., .T.,,,,,, "", oMenu,,,,,,,,,,,,, aClrMenu1, nRGB( 125, 172, 215 ),;
nRGB( 65, 106, 189 ) )

oTBtn0:aClrGradOver = { || aClrMenu2 }
oTBtn0:aClrGradBack = aClrMenu2
oTBtn0:bClrGradSubOver = { || aClrMenu2 }

oTBtn1 = TRBtn():New( 4, 410,,, ".\bitmaps\new2.bmp", {|| ;
cFileDisc := "Nuevo.Txt", cText := "Nuevo.. ", ;
MemoWrit( cFileDisc, cText ), ;
cText := MemoRead( cFileDisc ), cText := iif( IsOem( cText ), OemToAnsi( cText ), cText ),;
iif( at( cTextFormat, cText ) = 0, (Eval( bFnt ), cText := TxtToGTF( cText, , oFont, nColor ),;
MemoWrit( cFileDisc, cText )), Nil ), aFiles[1] := cFileDisc, cTit := "Wocul3.Exe - " + cFileDisc,;


oGet:cText( cText ), oGet:Refresh(), oWnd:SetText( cTit ), oWnd:Refresh() }, oRBar )

oTBtn2 = TRBtn():New( 4, 435,,, ".\bitmaps\open2.bmp", {|| ;
iif( lG32, ;
cFileNw := cGetFile32( cFileName( cFileDisc ) + ;
"Todos ( *.* ) | *.* ", ;
"Elija Origen y Nombre", 01, ".\", .f., .t., cFileDisc ), ;
cFileNw := cGetFile( cFileName( cFileDisc ) + ;
"Todos ( *.* ) | *.* ", ;
"Elija Origen y Nombre", 01, ".\", .f., .t., cFileDisc ) ), ;
cFileDisc := iif( !Empty( cFileNw ), cFileNw, cFileDisc ), ;
cText := MemoRead( cFileDisc ), cText := iif( IsOem( cText ), OemToAnsi( cText ), cText ),;
iif( at( cTextFormat, cText ) = 0, (Eval( bFnt ), cText := TxtToGTF( cText, , oFont, nColor ),;
MemoWrit( cFileDisc, cText )), Nil ), aFiles[1] := cFileDisc, cTit := "Wocul3.Exe - " + cFileDisc,;


oGet:cText( cText ), oGet:Refresh(), oWnd:SetText( cTit ), oWnd:Refresh() }, oRBar )

oTBtn3 = TRBtn():New( 4, 485,,, ".\bitmaps\exit2.bmp", {|| oWnd:End() }, oRBar )
//460
oTBtn4 = TRBtn():New( 4, 60,,, ".\bitmaps\save16.bmp", {|| MemoWrit( cFileDisc, cText ), ;
MsgWait( "Texto y Formato guardados .." , cFileDisc, 0.8 ), lChange := .f. }, oRBar )

oTBtn5 = TRBtn():New( 4, 460,,, ".\bitmaps\printquick16.bmp", {|| Imprimir( oGet, cFileDisc ), ;
cText := MemoRead(

cFileDisc ), oGet:cText( cText ), oGet:Refresh() }, oRBar )

ADD GROUP oGr RIBBON oRBar TO OPTION 1 PROMPT "Portapapeles" width 130 //BITMAP

"c:\fwh\bitmap\fivetech.BMP"

ADD GROUP oGr1 RIBBON oRBar TO OPTION 1 PROMPT "Formatear Texto" WIDTH 205 ACTION MsgInfo( "SÍ" )

ADD GROUP oGr2 RIBBON oRBar TO OPTION 1 PROMPT "Alineación" WIDTH 215

ADD GROUP oGr3 RIBBON oRBar TO OPTION 1 PROMPT "Stilos" WIDTH 75 BITMAP ".\bitmaps\style16.BMP"

ADD GROUP oGr4 RIBBON oRBar TO OPTION 1 PROMPT "Editing"

@ 2,5 ADD BUTTON oBtn1 PROMPT "Pegar" BITMAP ".\bitmaps\PASTE32.BMP" GROUP oGr ACTION ( RIBBON() ) ;
SPLITPOPUP ROUND SIZE 50,65

@ 2, 55 ADD BUTTON oBtn2 GROUP oGr BITMAP ".\bitmaps\cut16.BMP" ;
SIZE 60, 20 PROMPT "Cortar" MOSTLEFT round ;
action ( oGet:Cut(), lChange := .t., lAct := .t. )

@ 24, 55 ADD BUTTON oBtn3 GROUP oGr BITMAP ".\bitmaps\copy16.BMP" ;
SIZE 65, 20 PROMPT "Copiar" MOSTLEFT round ;
action( ( oGet:Copy(), lChange := .t., lAct := .t. ) )

@ 46, 55 ADD BUTTON oBtn4 GROUP oGr BITMAP ".\bitmaps\paste16.BMP" ;
SIZE 70, 20 PROMPT "Pegar" MOSTLEFT round ;
action( ( oGet:Paste(), lChange := .t., lAct := .t. ) )

@ 68, 30 ADD BUTTON oSay1 GROUP oGr SIZE 65, 15 PROMPT "Un texto" SAYBUTTON

@ 10, 05 ADD BUTTON oBtn5 GROUP oGr1 BITMAP ".\bitmaps\bold16.bmp" GROUPBUTTON FIRST SIZE 25, 20 ROUND ;
ACTION ( oBtn5:lSelected := !oBtn5:lSelected, Fuentes( 1 ) )

@ 10, 30 ADD BUTTON oBtn6 GROUP oGr1 BITMAP ".\bitmaps\italic16.bmp" GROUPBUTTON SIZE 25, 20 ROUND ;
ACTION ( oBtn6:lSelected := !oBtn6:lSelected, Fuentes( 2 ) )

@ 10, 55 ADD BUTTON oBtn7 GROUP oGr1 BITMAP ".\bitmaps\underline16.bmp" GROUPBUTTON SIZE 35, 20 ROUND ;
ACTION ( oBtn7:lSelected := !oBtn7:lSelected, Fuentes( 3 ) )

@ 10, 90 ADD BUTTON oBtn8 GROUP oGr1 BITMAP ".\bitmaps\strikethru16.bmp" GROUPBUTTON SIZE 25, 20 ROUND;
ACTION( oBtn8:lSelected := !oBtn8:lSelected, Fuentes( 4 ) )


//@ 10, 115 ADD BUTTON oBtn9 GROUP oGr1 BITMAP ".\bitmaps\subindex16.bmp" GROUPBUTTON SIZE 25, 20 ROUND;
// ACTION( oBtn9:lSelected := !oBtn9:lSelected, oBtn10:lSelected := .f., oBtn10:Refresh() )

// @ 10, 140 ADD BUTTON oBtn10 GROUP oGr1 BITMAP ".\bitmaps\superindex16.bmp" GROUPBUTTON SIZE 25, 20

ROUND ;
// ACTION( oBtn10:lSelected := !oBtn10:lSelected, oBtn9:lSelected := .f., oBtn9:Refresh() )

@ 10, 140 ADD BUTTON oBtn10 GROUP oGr1 BITMAP ".\bitmaps\eraseformat16.bmp" GROUPBUTTON FIRST SIZE 25,

20 ROUND ;
ACTION( ; // oBtn10:lSelected := !oBtn10:lSelected, oBtn9:lSelected := .f., oBtn9:Refresh() )
cText := GTFToTxt( cText ), MemoWrit( aFiles[ nItem ], cText ), ;
iif( at( cTextFormat, cText ) = 0, (Eval( bFnt ), cText := TxtToGTF( cText, , oFont, nColor ),;
MemoWrit( cFileDisc, cText )), Nil ), aFiles[1] := cFileDisc, cTit := "Wocul3.Exe - " + cFileDisc,;


oGet:cText( cText ), oGet:Refresh(), oWnd:SetText( cTit ), oWnd:Refresh() )

@ 10, 165 ADD BUTTON oBtn11 GROUP oGr1 BITMAP ".\bitmaps\casing16.bmp" GROUPBUTTON END SIZE 35, 20 ROUND

;
POPUP MENU oMLetras

// @ 40, 05 ADD BUTTON oBtn11 GROUP oGr1 BITMAP ".\bitmaps\hilight16.bmp" GROUPBUTTON FIRST SIZE 35, 20;
// ROUND
@ 40, 05 ADD BUTTON oBtn11 GROUP oGr1 BITMAP ".\bitmaps\Styleset16.bmp" GROUPBUTTON FIRST SIZE 35, 20;
ROUND ACTION ( oGet:GetFontColor(), lChange := .t., lAct := .t. )

@ 40, 40 ADD BUTTON oBtn12 GROUP oGr1 BITMAP ".\bitmaps\fontcolor16.bmp" GROUPBUTTON END SIZE 35, 20 ;
ROUND ACTION( oGet:GetColor(), lChange := .t., lAct := .t. )

@ 40, 100 ADD BUTTON oBtn13 GROUP oGr1 BITMAP ".\bitmaps\fontsizeincrease16.bmp" GROUPBUTTON ;
FIRST SIZE 25, 20 ROUND ACTION Fuentes( 5 )


@ 40, 125 ADD BUTTON oBtn14 GROUP oGr1 BITMAP ".\bitmaps\fontsizedecrease16.bmp" GROUPBUTTON ;
END SIZE 25, 20 ROUND ACTION Fuentes( 6 )


@ 40, 175 ADD BUTTON oBtn16 GROUP oGr1 BITMAP ".\bitmaps\style16.bmp" SIZE 25, 20 ROUND BORDER ;
POPUP MENU oMLetras

@ 64, 70 ADD BUTTON oChk1 GROUP oGr1 BITMAP ".\bitmaps\checkon.bmp" MOSTLEFT SIZE 85, 18 PROMPT

"Checkbox" ;
ACTION ( lVal1 := ! lVal1, oChk1:SetFile( If( lVal1, ".\bitmaps\checkon.bmp", "..\bitmaps\checkoff.bmp" ) ) )


@ 10, 05 ADD BUTTON oBtn17 GROUP oGr2 BITMAP ".\bitmaps\unorderedlist16.bmp" GROUPBUTTON FIRST SIZE 35, 20

ROUND POPUP

@ 10, 40 ADD BUTTON oBtn18 GROUP oGr2 BITMAP ".\bitmaps\orderedlist16.bmp" GROUPBUTTON SIZE 35, 20 ROUND

POPUP

@ 10, 75 ADD BUTTON oBtn19 GROUP oGr2 BITMAP ".\bitmaps\multilevellist16.bmp" GROUPBUTTON END SIZE 35, 20

ROUND POPUP


@ 10, 110 ADD BUTTON oBtn20 GROUP oGr2 BITMAP ".\bitmaps\textalignleft16.bmp" GROUPBUTTON FIRST SIZE 25, 20

ROUND ;
ACTION( oGet:SetAlign( ES_LEFT ), lChange := lAct := .t., ChangeSelect( { oBtn20, oBtn21, oBtn22, oBtn23 } ) )

@ 10, 135 ADD BUTTON oBtn21 GROUP oGr2 BITMAP ".\bitmaps\textaligncenter16.bmp" GROUPBUTTON SIZE 25, 20

ROUND ;
ACTION( oGet:SetAlign( ES_CENTER ), lChange := lAct := .t., ChangeSelect( { oBtn21, oBtn20, oBtn22, oBtn23 } ) )

@ 10, 160 ADD BUTTON oBtn22 GROUP oGr2 BITMAP ".\bitmaps\textalignright16.bmp" GROUPBUTTON SIZE 25, 20

ROUND;
ACTION( oGet:SetAlign( ES_RIGHT ), lChange := lAct := .t., ChangeSelect( { oBtn22, oBtn21, oBtn20, oBtn23 } ) )

@ 10, 185 ADD BUTTON oBtn23 GROUP oGr2 BITMAP ".\bitmaps\textalignjustify16.bmp" GROUPBUTTON END SIZE 25,

20 ROUND;
ACTION( ; //Justify( oGet, oLine, oPrn, nMargen, nMargend, aJustif[ oGet:nLineRow ], oFontW )
ChangeSelect( { oBtn23, oBtn21, oBtn22, oBtn20 } ) )


@ 40, 05 ADD BUTTON oBtn24 GROUP oGr2 BITMAP ".\bitmaps\fill16.bmp" GROUPBUTTON FIRST SIZE 35, 20 ROUND

POPUP

@ 40, 40 ADD BUTTON oBtn25 GROUP oGr2 BITMAP ".\bitmaps\borderbottom16.bmp" GROUPBUTTON END SIZE 35, 20

ROUND

@ 40, 80 ADD BUTTON oBtn26 GROUP oGr2 BITMAP ".\bitmaps\indentdecrease16.bmp" GROUPBUTTON FIRST SIZE 25,

20 ROUND

@ 40, 105 ADD BUTTON oBtn27 GROUP oGr2 BITMAP ".\bitmaps\indentincrease16.bmp" GROUPBUTTON END SIZE 25,

20 ROUND

@ 40, 135 ADD BUTTON oBtn28 GROUP oGr2 BITMAP ".\bitmaps\sort16.bmp" SIZE 25, 20 ROUND BORDER

@ 40, 160 ADD BUTTON oBtn29 GROUP oGr2 BITMAP ".\bitmaps\paragraphspacing16.bmp" SIZE 25, 20 ROUND BORDER

@ 40, 185 ADD BUTTON oBtn30 GROUP oGr2 BITMAP ".\bitmaps\invisiblechars16.bmp" SIZE 25, 20 ROUND BORDER

@ 3,5 ADD BUTTON oBtn31 PROMPT "Cambiar"+CRLF+"Estilos" BITMAP ".\bitmaps\stylechange32.BMP" GROUP oGr3

menu oMenu ;
SPLITPOPUP ROUND SIZE 65,75 TOP

@ 2,5 ADD BUTTON oBtn32 PROMPT "Buscar" BITMAP ".\bitmaps\find32.BMP" GROUP oGr4 ;
SPLITPOPUP ROUND SIZE 50,65

@ 2, 55 ADD BUTTON oBtn33 GROUP oGr4 BITMAP ".\bitmaps\replace16.BMP" ;
SIZE 80, 20 PROMPT "Reemplazar" MOSTLEFT round ;
action( msginfo( "Reemplazar" ) )

@ 24, 55 ADD BUTTON oBtn34 GROUP oGr4 BITMAP ".\bitmaps\goto16.BMP" ;
SIZE 65, 20 PROMPT "Ir a" MOSTLEFT round ;
action( msginfo( "Ir a" ) )

@ 46, 55 ADD BUTTON oBtn35 GROUP oGr4 BITMAP ".\bitmaps\select16.BMP" ;
SIZE 70, 20 PROMPT "Seleccionar" MOSTLEFT round POPUP

// SET MESSAGE OF oWnd TO "Testing FWH own Class RibbonBar" ;
// CENTERED CLOCK KEYBOARD 2007

// ACTIVATE WINDOW oWnd

// oRBar:End()



endif

// FIN DE LA PRIMERA PARTE

[Juan Planelles]

//SEGUNDA PARTE
if lHelp
oImageList = TImageList():New()

// oBmp1 = TBitmap():Define( , ".\BITMAPS\wdoc2.bmp" , oWnd )
oBmp1 = TBitmap():Define( , ".\BITMAPS\WDoc.bmp", oWnd )
oBmp2 = TBitmap():Define( , ".\BITMAPS\wFrmmask.bmp", oWnd )
oImageList:Add( oBmp1, oBmp2 ) // Image 0 = OMISION

// 1 ..
oImageList:Add( TBitmap():Define( , ".\BITMAPS\wfolder.bmp",, oWnd ), ; // nImage == 1 (default if not specified)
TBitmap():Define( , ".\BITMAPS\wfldMask.bmp",, oWnd ) )

// 2 ..
oImageList:Add( TBitmap():Define( , ".\BITMAPS\wSource.bmp", oWnd ),;
TBitmap():Define( , ".\BITMAPS\wFrmmask.bmp",, oWnd ) ) // 2

// 3
oImageList:Add( TBitmap():Define( , ".\BITMAPS\wPrint3.bmp",, oWnd ), ; // nImage == 3
TBitmap():Define( , ".\BITMAPS\wFrmmask.bmp",, oWnd ) )

// 4
oImageList:Add( TBitmap():Define( , ".\BITMAPS\wPeople.bmp",, oWnd ),; // nImage == 4
TBitmap():Define( , ".\BITMAPS\wFrmmask.bmp",, oWnd ) )

// 5
oImageList:Add( TBitmap():Define( , ".\BITMAPS\wInd.bmp",, oWnd ),; // nImage == 7
TBitmap():Define( , ".\BITMAPS\wIndMask.bmp",, oWnd ) )

oTree = TTreeView():New( 2, 0, oWnd )

oTree:SetImageList( oImageList )

oItem1 = oTree:Add( "Ayuda de Menú Inicial" )
aFiles[1] := 'INICIAL.WLT'
aItems[1] := "Ayuda de Menú Inicial"

oItem2 := oItem1:Add( "Pacientes", 0 )
aFiles[2] := 'PACIENTE.WLT'
aItems[2] := "Pacientes"

oItem2:Add( "Búsqueda y creación", 4 )
aFiles[3] := 'BUSQUEDA.WLT'
aItems[3] := "Búsqueda y creación"

oItem2:Add( "Listados y correo", 2 )
aFiles[4] := 'LISTADOS.WLT'
aItems[4] := "Listados y correo"

oItem2:Add( "Protección de datos", 1 )
aFiles[5] := 'PROTECC.WLT'
aItems[5] := "Protección de datos"

oItem2:Add( "Agenda", 2 )
aFiles[6] := 'AG.WLT'
aItems[6] := "Agenda"

oItem3 := oItem1:Add( "Archivos", 0 )
aFiles[7] := 'FILES.WLT'
aItems[7] := "Archivos"

oItem3:Add( "Indexar bases datos", 5 )
aFiles[8] := 'INDEXAR.WLT'
aItems[8] := "Indexar bases datos"

oItem3:Add( "Apariencia y coordenadas ventanas", 2 )
aFiles[9] := 'VENTANAS.WLT'
aItems[9] := "Apariencia y coordenadas ventanas"

oItem3:Add( "Ejecutar otro programa", 1 )
aFiles[10] := 'EJECUTAR.WLT'
aItems[10] := "Ejecutar otro programa"

oItem3:Add( "Editores del S.O.", 2 )
aFiles[11] := 'EDITORES.WLT'
aItems[11] := "Editores del S.O."

oItem3:Add( "Impresos vacíos", 2 )
aFiles[12] := "VACIOS.WLT" //VACIOS.WLT'
aItems[12] := "Impresos vacíos"

oItem4 = oItem1:Add( "Mantenimiento", 0 )
aFiles[13] := 'MANTTO.WLT'
aItems[13] := "Mantenimiento"

oItem4:Add( "Gestión económica", 2 )
aFiles[14] := 'WBROJO.WLT'
aItems[14] := "Gestión económica"

oItem4:Add( "Membretes y Remite", 2 )
aFiles[15] := 'MEMBRETE.WLT'
aItems[15] := "Membretes y Remite"

oItem4:Add( "Controles del programa", 2 )
aFiles[16] := 'CLAVES.WLT'
aItems[16] := "Controles del programa"

oItem2 = oTree:Add( "Ayuda del Menú de Consultas" )
aFiles[17] := 'CONSULTA.WLT'
aItems[17] := "Ayuda del Menú de Consultas"

oItem2:Add( "Motivo", 2 )
aFiles[18] := 'MOTIVO.WLT'
aItems[18] := "Motivo"

oItem2:Add( "Antecedentes", 2 )
aFiles[19] := 'ANTECED.WLT'
aItems[19] := "Antecedentes"

oItem2:Add( "Historias", 2 )
aFiles[20] := 'MENUHIST.WLT'
aItems[20] := "Historias"

oItem2:Add( "Variar fecha", 2 )
aFiles[21] := 'VARIARFE.WLT'
aItems[21] := "Variar fecha"

oItem2:Add( "Informes", 2 )
aFiles[22] := 'INFORMES.WLT'
aItems[22] := "Informes"

oItem5 := oItem2:Add( "Prescripciones", 0 )
aFiles[23] := 'FWRITE.WLT'
aItems[23] := "Prescripciones"

oItem5:Add( "Receta", 2 )
aFiles[24] := 'RECETA.WLT'
aItems[24] := "Receta"

oItem5:Add( "Tratam. Automático y Protocolos", 2 )
aFiles[25] := 'PROTOCOL.WLT'
aItems[25] := "Tratam. Automático y Protocolos"

oItem5:Add( "Escrito Libre", 2 )
aFiles[26] := 'ESCRITO.WLT'
aItems[26] := "Escrito Libre"

oItem5:Add( "Carta de Remisión", 2 )
aFiles[27] := 'CARTA.WLT'
aItems[27] := "Carta de Remisión"

oItem5:Add( "Análisis", 2 )
aFiles[28] := 'ANALISIS.WLT'
aItems[28] := "Análisis"

oItem6 := oItem2:Add( "Exploraciones", 0 )
aFiles[29] := 'EXPLORAC.WLT'
aItems[29] := "Exploraciones"

oItem6:Add( "Refracción", 2 )
aFiles[30] := 'GRADUAR.WLT'
aItems[30] := "Refracción"

oItem6:Add( "P.I.O.", 2 )
aFiles[31] := 'PIO.WLT'
aItems[31] := "P.I.O."

oItem6:Add( "Textos de exploraciones", 2 )
aFiles[32] := 'EXPLORAC.WLT'
aItems[32] := "Textos de exploraciones"

oItem6:Add( "Tratamientos", 2 )
aFiles[33] := 'BASEAUX.WLT'
aItems[33] := "Tratamientos"

oItem7 := oItem2:Add( "Minutar", 0 )
aFiles[34] := 'MINUTAR.WLT'
aItems[34] := "Minutar"

oItem7:Add( "Facturas", 2 )
aFiles[35] := 'FACTURA.WLT'
aItems[35] := "Facturas"

oTree:Add( "Textos, imprimir", 3 )
aFiles[36] := 'PRNFILE.WLT'
aItems[36] := "Textos, imprimir"

oTree:Add( "Gafas, receta", 3 )
aFiles[37] := 'PRNGAFA.WLT'
aItems[37] := "Gafas, receta"

aItems[38] := "Guia Rápida"
oTree:Add( aItems[38], 0 )
aFiles[38] := 'GUIARAPD.WLT'

aItems[39] := "Información Errores .."
oTree:Add( aItems[39], 0 )
aFiles[39] := "ERRORES.WLT"

bExpand := {|| oTree:ExpandAll( oItem1 ) }
bCollaps := {|| oTree:CollapseAll( oItem1 ) }

nPar := Max( 1, nPar )
nPar := iif( nPar == Len( aFiles ), nPar, Min( nPar, Len( aFiles ) ) )
nItem := nPar
// ? nPar, aFiles[nPar], aItems[nPar]
Eval( bIt )
endif

cText := Memoread( aFiles[ nItem ] )
// ? nPar, aFiles[nPar], cFileDisc, aItems[nPar]

// Pasarlo a minusculas con sintaxis y acronimos si están elegidos
memory( -1 )
// Llamada automática antes que se convierta en FORMAT GET

if at( cTextFormat, cText ) == 0
cFileDisc := aFiles[ nItem ]
do case
case lFile2 // historias
cFAcro := "ACRONIMS.DAT"
if Len( cText ) < 5000
if lSintax
//cText := Letras( 3 )
endif
endif
if lAcro
//cText := Acro( )
endif
case lFile
cFAcro := "ACRONIM2.DAT"
if lAcro
//cText := Acro( )
endif
endcase
endif

do case
case lFile2 // historias
cFAcro := "ACRONIMS.DAT"
case lFile
cFAcro := "ACRONIM2.DAT"
endcase

// Pasarlo a GTF si no era
if !IsGTF( cText ) .or. at( cTextFormat, cText ) == 0
//cText := GTFToTxt( cText ) // por si acaso hay incompletos
Eval( bFnt )
cText := TxtToGTF( cText, , oFont, nColor )
MemoWrit( aFiles[ nItem ],

cText )
endif
if lHelp
oTree:bLDblClick := { | nRow, nCol, nKeyFlags | ;
MyClick( nRow, nCol, oTree, aItems, aFiles, .t., 1, nColor ),;
oGet:SetFocus(), oGet:Refresh() }
endif

SET MESSAGE OF oWnd TO "" KEYBOARD NOINSET

DEFINE MSGITEM oMsgItem PROMPT "" SIZE 120 OF oWnd:oMsgBar

//205



300
@ iif( lCinta, 140, 29 ), iif( lHelp, 210, 50 ) FORMAT GET oGet VAR cText SIZE 300,200 PIXEL OF oWnd
//oGet:bGotFocus := {|| iif( nVal == 2, oGet:KeyDown( VK_DELETE ), oGet:KeyDown( VK_INSERT ) ) } MAL, SE PONE

EN INIT DE LA VENTANA
oGet:bChange := {|| lChange := .t., Eval( bResize ) }
// oGet:bRClicked := {|| .f. } // Impedir que se abra el menú contextual de la ventana get
oGet:bRClicked := {| nRow, nCol, nFlags| ShowP( nRow, nCol, oGet ) } // Impedir que se abra el menú contextual

de la ventana get
oGet:bMouseWheel = { | nKey, nDelta, nXPos, nYPos | MouseWheel( nKey, nDelta, nXPos, nYPos, oGet ) } // Rueda

del raton
if lFile
cFileDisc := aFiles[ nItem ]
//cText := Memoread( aFiles[ nItem ] ) // nItem = 1 = nombre archivo traspasado en cpar
//cText := MemoTran( cText )
endif

if lHelp
@ 29, 200 SPLITTER oSplit ;
VERTICAL _3DLOOK ;
PREVIOUS CONTROLS oTree ;
HINDS CONTROLS oGet ;
SIZE 4, 200 PIXEL ;
LEFT MARGIN 50 ;
RIGHT MARGIN 100 ;
OF oWnd UPDATE //ON MOVE Eval( bResize )

oSplit:lMoving := {|| Eval( bReSize ), oWnd:Refresh(), oGet:Refresh() }

endif

oWnd:cToolTip:= "Doble Click sobre <Ayuda Menu Inicial> para LEERLO"

oWnd:bKeyChar = { | nKey, nFlags | iif( nKey == 27 .and. ;
MsgYesNo( '¿Desea SALIR de Ayudas ..?' ), ;
oWnd:End(), Nil ) }
oGet:nLeftMargin := Space( 5 )
oGet:bLocate := {| nRow, nCol | oMsgItem:SetText( "Lin: " + Str( nRow, 4 ) + " " +;
"Col: " + Str( nCol, 4 ) ) }

ACTIVATE WINDOW oWnd ON PAINT Eval( bResize ) ;
ON MOVE ( oWnd:CoorsUpdate(), Eval( bReSize ), ;
MemoWrit( cFCoors, Str( oWnd:nTop/16, 10, 2 ) + CRLF + ;
Str( oWnd:nLeft/8, 10, 2 ) + CRLF + ;
Str( oWnd:nBottom/16, 10, 2 ) + CRLF + ;
Str( oWnd:nRight/8, 10, 2 ) ), ;
oWnd:Refresh() ) ;
ON RESIZE ( iif( lHelp, oSplit:AdjClient(), Nil ), Eval( bresize ), ;
MemoWrit( cFCoors, Str( oWnd:nTop/16, 10, 2 ) + CRLF + ;
Str( oWnd:nLeft/8, 10, 2 ) + CRLF + ;
Str( oWnd:nBottom/16, 10, 2 ) + CRLF + ;
Str( oWnd:nRight/8, 10, 2 ) ) ) ;
ON INIT ( iif( nVal == 2, oGet:KeyDown( VK_DELETE ), oGet:KeyDown( VK_INSERT ) ),;
cFileDisc := aFiles[ nPar ], nItem := nPar, cText := memoread( cFileDisc ), ;
iif( at( cTextFormat, cText ) == 0,;
( Eval( bFnt ),;
cText := TxtToGTF( cText, , oFont, nColor ) ), Nil ),;
oGet:cText( cText ), lChange := .t., ;
oGet:Refresh(), CursorArrow(),;
iif( !lVacio .and. lHelp, ;
( oTree:aItems[ nI ]:Expand(), Eval( bIt ), ;
MyClick( 0, 0, oTree, aItems, aFiles, .f., nPar, nColor ), ;
oTree:Refresh() ), Nil ) ) ;
VALID ( iif( lChange .and. MsgYesNo( "¿Guardar Cambios?", "El texto ha cambiado" ), ;
( MemoWrit( cFileDisc, cText ), ;
MsgWait( "Texto guardado .." , cFileDisc, 0.8 ),

lSalir := .t. ), lSalir := .t. ), (lSalir) )

oImageList:End()
oBmp1:End()
oBmp2:End()

return nil

function MyClick( nRow, nCol, oTree, aItems, aFiles, lVacio, nVal, nColor )
local oItem, cItem, cDirect
if nItem < 1 .or. nItem > Len( aFiles )

nItem := iif( nItem < 1, 1, Len( aFiles ) )
else
iif( lChange, ;
( MemoWrit( cFileDisc, cText ), lChange := .f., ;
MsgWait( "Texto guardado .." , cFileDisc, 0.8 ) ),

Nil )
// Salvar los cambios antes de cargar siguiente
endif

nVez ++

if lVacio
oItem := oTree:HitTest( nRow, nCol )
if oItem != Nil
cItem := oItem:cPrompt
//? cItem, nItem, aFiles[nItem], aItems[nItem]
nItem := Ascan( aItems, cItem )
//? cItem, nItem, aFiles[nItem], aItems[nItem]
// Evitar error
if nItem < 1 .or. nItem > Len( aFiles )
nItem := iif( nItem < 1, 1, Len( aFiles ) )
oWnd:SetText( cTit + ' - ' + aItems[nItem] )
oWnd:Refresh()
// ? nItem, aFiles[nItem], aItems[nItem]
else
oWnd:SetText( cTit + ' - ' + oItem:cPrompt )
oWnd:Refresh()
endif
else
MsgBeep()
cFileDisc := aFiles[ nPar ] //nItem ]
cText := memoread( aFiles[ nItem ] )
if at( cTextFormat, cText ) == 0
Eval( bFnt )
cText := TxtToGTF( cText, , oFont, nColor )

endif
oGet:cText( cText )
oGet:Refresh()

Return Nil

endif
endif

// o por llamada ( no por click )
if nItem > 0 //!Empty( cItem ) //oItem != NIL

cText := ''

if !File( aFiles[ nItem ] )
MsgInfo( "Archivo " + aFiles[ nItem ] + " NO HALLADO !." )
else

cFile := aFiles[ nItem ]
cFileDisc := aFiles[ nItem ]
cDirect := DIRECTORY( cFile )

cText := memoread( cFileDisc )
if at( cTextFormat, cText ) == 0
Eval( bFnt )
cText := TxtToGTF( cText, , oFont, nColor )

endif
oGet:cText( cText )
oGet:Refresh()
oWnd:Refresh()
endif

else

endif

return NIL

function MouseWheel( nKey, nDelta, nXPos, nYPos, oGet )
local oLine := oGet:oLine
local nLine := oGet:nLineRow
local nTotal := oGet:nLineCount

if nDelta < 0
if nLine < nTotal
nLine += nSalto
oGet:Goline( nLine )
endif

// oGet:GoNextLine()
else
// oGet:GoPrevLine()
if nLine > nSalto //( oLine != oGet:oLineInit )
nLine -= nSalto
else
nLine := 1
endif
oGet:Goline( nLine )
endif
return NIL

//----------------------------------------------------------------------------//

Function GoLine()

Local nLine := oGet:nLineRow

if MsgGet( "Go to line", "N. Line:", @nLine )

oGet:GoTo( nLine )

endif

return nil

//----------------------------------------------------------------------------//

Function Find()

Local cText := Space( 129 )

if GetFocus() != oGet:hWnd
SetFocus( oGet:hWnd )
endif

if MsgGet( "Busca texto", "Texto:", @cText )

cTextFind := Trim( cText )
oGet:Find( cTextFind )

endif

return nil

//----------------------------------------------------------------------------//

Function FindNext()

if GetFocus() != oGet:hWnd
SetFocus( oGet:hWnd )
endif

oGet:GoNextChar()

if !oGet:FindNext( cTextFind )

oGet:GoPrevChar()

endif

return nil

//----------------------------------------------------------------------------//

Function Information()

local oLine := oGet:oLine

local aAlign := { "IZQUIERDA", "CENTRAR", "DERECHA" }

local cInfo := ""

oGet:GetDC()

cInfo := "Tablas: " + Str( Len( oLine:aText ) ) + CRLF +;
"Texto: " + oGet:GetTextLine( oLine ) + CRLF +;
"Alineación: " + aAlign[ oLine:nAlign + 1 ] + CRLF +;
"Retorno Carro: " + if( oLine:lCrLf, "SI", "NO" ) + CRLF +;
"Es linea primera: " + if( oLine == oGet:oLineInit, "SI", "NO" ) + CRLF +;
"Es linea última: " + if( oLine == oGet:oLineEnd, "SI", "NO" ) + CRLF +;
"Fila: " + Str( oGet:nRow ) + " pixels" + CRLF +;
"Columna cursor: " + Str( oGet:nCol + 1 ) + " pixels" + CRLF +;
"Núm. Linea Texto " + Str( oGet:nLineRow ) + CRLF +;
"Núm. Col. Texto " + Str( oGet:nLineCol + 1 ) + CRLF +; // empieza en la cero
"Caracteres en la linea: " + Str( oGet:LenLine( oLine ) ) + CRLF +;
"Altura linea: " + Str( oGet:HeightLine( oLine ) ) + " pixels" + CRLF +;
"Anchura linea: " + Str( oGet:WidthLine( oLine ) ) + " pixels" + CRLF +;
"Total de lineas" + Str( oGet:nLineCount ) + CRLF +;
"Total de caracteres" + Str( oGet:LenText() ) + CRLF

MsgInfo( cInfo )

oGet:ReleaseDC()

return nil

//METHOD Print() CLASS TFGet

Static Function Imprimir( oGet, cName, oFontX, nColorX )

local n, nMargen := 4, nCols, nFilas, nFactor := 0.70, nFilaIni := 2, lUser := .t., aJustif := {}

local xxx := 0, cLine, cLinea, nAncho, nCar, nC, cTx2, cVal := ""

local nRow := 0, nRowNw := 0
local nCol := 0, nI := 0

local nWidth //, oLin := oGet:oLineInit
local nRowStep

local oLine := oGet:oLineInit

local cText, cMemo := MemoRead( CFGAYUDA ), nWEdit := Eval({|| oGet:nWidth })

local oFontW, nFont, oFont2, nMargend
local nLenFonts := Len( oGet:aFonts )
local aFonts := Array( nLenFonts ), cTextForm, nCrLf, lFocus, cChars

local lFile32 := ( File( 'Prev32.Dll' ) .or. ;
File( AllTrim( GetSysDir() ) + '\Prev32.Dll' ) )

//aVal := { nFilaIni, lPrev, nMargen, nFactor }
nFilaIni := Val( AllTrim( memoLine( cMemo, , 1 ) ) )
lPrev := ( AllTrim( memoLine( cMemo, , 2 ) ) == "S" )
lPrevIni := ( AllTrim( memoLine( cMemo, , 5 ) ) == "S" )
lCuart := ( AllTrim( memoLine( cMemo, , 8 ) ) == "S" )
nMargend := Val( AllTrim( memoLine( cMemo, , 9 ) ) )

if lPrev .and. !( lFile32 )
? 'Prev32.Dll: NO Instalado' + CRLF + ;
'PREIMPRESOS NO

DISPONIBLES.'
lPrev := .f.
endif

nMargen := Val( AllTrim( memoLine( cMemo, , 3 ) ) )
nFactor := Val( AllTrim( memoLine( cMemo, , 4 ) ) )
nFactor := Max( nFactor, 0.20 )
lPrevIni := ( AllTrim( memoLine( cMemo, , 5 ) ) == "S" )

DEFINE FONT oFont2 NAME GetSysFont() SIZE 0, -12

// oPrn := TPrinter():New( cName, .f., lPrev )
cNamePre := "Fichero: " + cName
if lPrev
PRINT oPrn NAME cNamePre PREVIEW
else
PRINT oPrn NAME cNamePre
endif
lMetaf := lPrev
//cNamePre := cName
if Empty( oPrn:hDC )
MsgStop( "Impresora no preparada !", "Aviso !." )
oPrn := ""; lMetaf := .f. ; lPrev := .f.
return oGet
endif

nCols := oPrn:nHorzRes()/80 // 80 columnas, numero de pixels por columna para ciertas cosas
nFilas:= oPrn:nVertRes()/70 // 70 lineas por pagina
nFilaIni:= nFilas*nFilaIni
nMargen := nCols*nMargen
nMargend := nCols*nMargend
CursorWait()
if File( "LIS_RED.DBF" )
DbUseArea( .t., , "Lis_Red", , .t. ) // modo compartido
Lis_Red->( DbGoto( nUsuario ) )
else
lMembr := .f.
endif
for n:= 1 to nLenFonts
oFontW:= oGet:aFonts[ n ]
if oFontW:nWidth == oFontW:nHeight * 0.44
aFonts[ n ] := TFont():New( iif( Empty( oFontW:cFaceName ), "Arial", oFontW:cFaceName ), ;


0, ( Abs( oFontW:nHeight ) * -1 )*nFactor, ,;
oFontW:lBold, , , , oFontW:lItalic, oFontW:lUnderline,;
oFontW:lStrikeOut, , , , , oPrn )
else
aFonts[ n ] := TFont():New( iif( Empty( oFontW:cFaceName ), "Arial", oFontW:cFaceName ), ;


( oFontW:nWidth )*nFactor, ( oFontW:nHeight )*nFactor, ,;
oFontW:lBold, , , , oFontW:lItalic, oFontW:lUnderline,;
oFontW:lStrikeOut, , , , , oPrn )
endif
next
//oPrn:StartPage()
nI := 0
PAGE
nI++
if (lFile) .and. ( lMembr ) .and. nI == 1
nRow := membrete( oPrn, oFont2, GetWndDefault(), "", .f., "P", , nMargen, nFilas, nCols, nFilaIni, ;
oFontX, nColorX )
endif


// Primero comprobar que el ancho de resolucion horiz impresora no se sobrepasa
nWidth := 0
do while oLine != nil
nRowStep := 0
nWidth := 0

for n = 1 to Len( oLine:aText )
cText := oLine:aText[ n ]
nFont := AScan( oGet:aFonts, { |oFontW| oFontW:hFont == oLine:aFonts[ n ] } )
nFont := Max( 1, nFont )
oFontW := aFonts[ nFont ]

nWidth += oPrn:GetTextWidth( cText, oFontW )
nRowStep := Max( nRowStep, Abs( oFontW:nHeight ) )

next

aadd( aJustif, ( oPrn:nHorzRes() -nMargend ) - ( nWidth + nMargen ) ) // array con diferencias a justificar
xxx := MAX( xxx, nWidth )
oLine := oLine:oDown
enddo

if ( nMargen + xxx ) > ( oPrn:nHorzRes() -nMargend )
MsgWait( "Hay líneas demasiado anchas." + CRLF + ;
"Estreche la ventana o los márgenes.", "Aviso !", 0.8 )
else

endif
// Fin de la comprobacion

// Inicio de imprimir
oLine := oGet:oLineInit

do while oLine != nil

// Para comprobar si va a caber en la pagina
nRowStep := 0
nWidth := 0
for n = 1 to Len( oLine:aText )
cText := oLine:aText[ n ]
nFont := AScan( oGet:aFonts, { |oFontW| oFontW:hFont == oLine:aFonts[ n ] } )
nFont := Max( 1, nFont )
oFontW := aFonts[ nFont ]
nWidth += oPrn:GetTextWidth( cText, oFontW )
nRowStep := Max( nRowStep, Abs( oFontW:nHeight ) )
next
nRow += nRowStep // esto era lo original de la clase

if nRow + nFilaIni > oPrn:nVertRes()
nRow := nFilaIni
ENDPAGE
PAGE
// oPrn:EndPage()
// oPrn:StartPage()
endif
// fin comprobar si cabe en la pagina

SetTextAlign( oPrn:hDC, nMargen ) //TA_BASELINE )
do case
case oLine:nAlign == ES_LEFT
nCol := nMargen + 0 // p q haya un margen izq
case oLine:nAlign == ES_RIGHT
nCol := oPrn:nHorzRes() - ( nWidth + nMargend )
nCol := nCol -nMargen // p q haya un margen dcho
case oLine:nAlign == ES_CENTER
nCol := ( oPrn:nHorzRes() - nWidth ) / 2
endcase

// Justificar si se ha elegido, las lineas que procedan
if lJustif .and. !( oLine:lCrLf ) .and. oLine:nAlign == ES_LEFT .and. ( aJustif[ oGet:nLineRow ] > 0 ) .and. ;
aJustif[ oGet:nLineRow ] < (

oPrn:nHorzRes() -nMargend - nMargen )*0.50 // Justificar las alineadas a la izquierda
oLine := Justify( oGet, oLine, oPrn, nMargen, nMargend, aJustif[ oGet:nLineRow ], oFontW )
endif

nRowStep := 0
nWidth := 0

for n = 1 to Len( oLine:aText )

if oLine == oGet:oLineInit
nRow := nRow + nFilaIni - Abs( oFontW:nHeight )
endif

cText := oLine:aText[ n ]
nFont := AScan( oGet:aFonts, { |oFontW| oFontW:hFont == oLine:aFonts[ n ] } )
nFont := Max( 1, nFont )
oFontW := aFonts[ nFont ]

// nRow := nRow - Abs( oFont:nHeight ) // esto era lo original de la clase
nRowNw := nRow - Abs( oFontW:nHeight )*0.85 // p q no se bajen las fuentes grandes

oPrn:Say( nRowNw, nCol, cText, oFontW, , oLine:aColors[ n ] )
nCol += oPrn:GetTextWidth( cText, oFontW )
nWidth += oPrn:GetTextWidth( cText, oFontW )
next

nCol := 0

oLine := oLine:oDown

enddo
//oPrn:EndPage() //
ENDPAGE

//OutPrint() //
ENDPRINT

AEval( aFonts, { |oFontW| oFontW:End() } )
oFont2:End()

if File( "LIS_RED.DBF" )
Lis_Red->( DbCloseArea() )
endif

CursorArrow()

return nil
// FIN SEGUNDA PARTE

[Juan Planelles]

//TERCERA PARTE
Static Function Justify( oGet, oLine, oPrn, nMargen, nMargend, nJustif, oFontW )
local nPos, cLine := "", cChar := " ", nWidthChar := 0, aOpt := {}
local xxx := 0, nVez := 0, nJust := 0, nI, lSeguir := .t., n, nFont, aText, cLinea, cIni, nIni
local cTx2, cMemo := MemoRead( CFGAYUDA ), nWidth, nWidMemo
local nLenFonts := Len( oGet:aFonts ), nRowStep
local aFonts := Array( nLenFonts ), nLen, nChar, cEdit, cTc, cT
local cLineText, bEvalWidt, cTextForm := oGet:GetTextLine( oLine )
local aVar := {}, nAt, aLen := {}, aL := {}, nVar := 0, aLenText := Len( oLine:aText )
local nPosLine := oGet:nLineRow, aTextLine := oLine:aText, aFontsLine := oLine:aFonts, ;
aColorsLine := oLine:aColors
local nFactor := Val( AllTrim( memoLine( cMemo, , 4 ) ) )
nFactor := Max( nFactor, 0.20 )

/*
oGet:GetDC()
bEvalWidt := {|| lSeguir := .t., nWidth := 0, ;
aEval( oLine:aText, {|c,nI| n := nI, ;
cTx2 := oLine:aText[ n ], ;
nFont := AScan( oGet:aFonts, { |oFontW| oFontW:hFont == oLine:aFonts[ n ] } ),;
nFont := Max( 1, nFont ), ;
oFontW := aFonts[ nFont ], ;
nWidth += oPrn:GetTextWidth( cTx2, oFontW ), ;
lSeguir := iif( !( ( nMargen + nWidth ) < ( oPrn:nHorzRes() -nMargend ) ), .f., lSeguir ) ;
} ) }

aVar := Array( Len( oLine:aText ) )
aFill( aVar, 1 )
aL := Array( Len( oLine:aText ) ) ; aFill( aL, 0 )
aLen := {}

//nIni := Len( cLineText ) - Len( Ltrim( cLineText ) ) // si hay espacios iniciales
Do While lSeguir

nWidth := 0
nVar ++
aL := iif( nVar == 1, aFill( aL, 0 ), aL )

for n = 1 to Len( oLine:aText )
aVar := iif( nVar == 1, aFill( aVar, 1 ), aVar )
aL := iif( nVar == 1, aFill( aL, 0 ), aL )

cTx2 := oLine:aText[ n ]
if nVar == 1
nIni := Len( cTx2 ) - Len( Ltrim( cTx2 ) ) + 1 // si hay espacios iniciales
else
nIni := aL[ n ] + 1
endif

if nVar == 1
cT := Left( cTx2, Len( cTx2 ) - Len( Ltrim( cTx2 ) ) )
else
cT := Left( cTx2, aL[ n ] )
endif

if nVar == 1
cTc := SubsTr( cTx2, Len( cTx2 ) - Len( Ltrim( cTx2 ) )+1 )
else
cTc := SubsTr( cTx2, aL[ n ] + 1 )
endif

nAt := at( " ", cTc )

// cTc := iif( nAt > 0, cTc := Stuff( cTc, nAt, 2, CHR( 32 ) + CHR( 32 ) ), cTc )

cTx2 := cT + cTc
aVar[ n ] := iif( nAt > 0, nAt +1 , 0 )
aVar[ n ] := Len( cT ) + aVar[ n ]
aL[ n ] := aVar[n]

oGet:InsChar( oLine, aL[n], " " )
oGet: DrawCurLine() // INLINE ::DrawLine( ::oLine, ::nRow, .t., .t. )
oGet:Refresh()

// oLine:aText[ n ] := cTx2
Eval( bEvalWidt )
if !lSeguir
exit
endif
next
// ? "1: " + cTx2, "2: " + cT, "3: " + cTc
//oGet:FormatFLine( oLine:aText, , ,oLine:aFonts, oLine:aColors )
Eval( bEvalWidt )
aEval( aVar, {| c, X | lSeguir := iif( aVar[X] == 0, .f., lSeguir ) } )
EndDo
// oGet:FormatFLine( oLine:aText, oLine:aFonts, oLine:aColors, nPosLine )
*/
// FormatFLine( oLine:aText, oLine:aFonts, oLine:aColors, nPos ) OJOOOOOOOOO ESTOOOOOO

bEvalWidt := {|| lSeguir := .t., nWidth := 0, ;
aEval( oLine:aText, {|c,nx| nI := nx, ;
cText := oLine:aText[ nI ], ;
nFont := AScan( oGet:aFonts, { |oFontW| oFontW:hFont == oLine:aFonts[ nI ] } ),;
nFont := Max( 1, nFont ), ;
oFontW := aFonts[ nFont ], ;
nWidth += oPrn:GetTextWidth( cText, oFontW ), ;
lSeguir := iif( !( ( nMargen + nWidth ) < ( oPrn:nHorzRes() -nMargend ) ), .f., lSeguir ) ;
} ) }

cLineText := oGet:GetTextLine( oLine )
cLineText := Trim( cLineText )
nIni := Len( cLineText ) - Len( Ltrim( cLineText ) ) // si hay espacios iniciales
nIni := Max( 1, nIni )

oGet:GetDC()

Do While lSeguir

cLineText := Trim( cLineText )
nLen := Len( cLineText )
For n = nIni To nLen
cTc := SubsTr( cLineText, n, 1 )
if cTc == " "
cLineText := Stuff( cLineText, n, 2, " " )

oGet:InsChar( oLine, n, " " ) //CHR( 32 ) ) //Space( 1 ) ) //" " )
oGet: DrawCurLine() // INLINE ::DrawLine( ::oLine, ::nRow, .t., .t. )
oGet:Refresh()

nLen++ // el nuevo largo
n ++ // pasar el espacio añadido
Eval( bEvalWidt )
if !lSeguir
exit
endif

endif
Next
if !lSeguir
exit
endif
EndDo

return oLine

//----------------------------------------------------------------------------//

static function Configurar()

local oFnt, lAcept := .f., cInfo, lYa := .t., os1, os2, os3, os4, os5, os6, ob3, ob4, ob5, ob6, oS7, oHand
local oK1, oK2, oK3, oK4, oK5, oK7, aVal := {}, nAncho := 5, oCbx, oAcro, lAcro := .f., cNota := "OD", ;
aItems := {}, aIt := { "OJO DERECHO", "OJO IZQUIERDO", "LOS DOS OJOS", "O.D.", "OD ", "OD:", ;
"VOD", "VOI", "O.I.", "OI ", "OI:", "L:", "C:", "PIO ", "P.I.O.", "PIO:", "D.R.", "DR.", "DR " }, ;
oSintax, nI := 0
local oBt1, oBmp, bSave, bLee, oBmp0, oMembr, oExit, oGr1, oGr2, oGr3, oGr4
local nFilaIni := 3, nMargen := 3, nFactor := 0.80, nVacio := 2, lExit := .t., cMemo := "" //, cFile := "ACRONIMS.DAT"
local cMem := MemoRead( CFGAYUDA ), oJustif, oM4, nMargend := 3 , n := 0, lChang := .f.
local bCrea, bWri, bSv, bBorra, oCuart, oFontW

nSalto := 15 //statica

cInfo := "Hay que establecer la linea en que se empieza a" + CRLF + ;
"escribir de un total de 70 lineas cada Folio," + CRLF + ;
"esto es el margen superior, así como poner" + CRLF + ;
" el número de columnas del margen izquierdo." + CRLF + CRLF + ;
"También especificar si se desea previsualizar" + CRLF + ;
"antes de imprimir, y si quiere que al cargar" + CRLF + ;
"el documento se previsualice automáticamente," + CRLF + ;
"y que se presente o no con membrete." + CRLF + CRLF + ;
"Por el formateado hay que aplicar un factor de " + CRLF + ;
"reducción al tamaño del font para que se imprima" + CRLF + ;
"similar a la pantalla, por omisión = 0.80." + CRLF + CRLF + ;
"El ancho de la ventana de texto debe ser unos 3 cm" + CRLF + ;
"menor que el ancho de un folio, para que las lineas" + CRLF + ;
"se impriman enteras, y ese ancho se determina" + CRLF + ;
"redimensionando el borde derecho de la ventana" + CRLF + ;
"y previsualizando para comprobar resultados." + CRLF + CRLF + ;
"Si el font no tiene nombre las letras se imprimen" + CRLF + ;
"mal, muy pequeñas." + CRLF + CRLF + ;
"El botón de <Reiniciar> da los valores iniciales" + CRLF + ;
"para imprimir." + IIF( lFile .or. lFile2, CRLF + CRLF + ;
"Puede establecer texto según sintáxis y poner en " + CRLF + ;
"mayúsculas los acrónimos, al cargar el fichero de texto." + CRLF + CRLF + ;
"Lo más fácil en la gestión de acrónimos es añadir o borrar" + CRLF +;
"desde la ventana que abre <Ver>" , "" )

aVal := { nFilaIni, lPrev, nMargen, nFactor, lPrevIni, lMembr, nVacio, lCuart, nMargend, lSintax, lAcro, nSalto, lJustif }

bSave := {|| MemoWrit( CFGAYUDA, Str( aVal[1], 5, 2 ) + CRLF + ;
iif( aVal[2] == .t., "S", "N" ) + CRLF + ;
Str( aVal[3], 5, 2 ) + CRLF + ;
Str( aVal[4], 5, 2 ) + CRLF + ;
iif( aVal[5] == .t., "S", "N" ) + CRLF + ;
iif( aVal[6] == .t., "S", "N" ) + CRLF + ;
Str( aVal[7], 1 ) + CRLF + ;
iif( aVal[8] == .t., "S", "N" ) + CRLF + ;
Str( aVal[9], 5, 2 ) + CRLF + ;
iif( aVal[10] == .t., "S", "N" ) + CRLF + ;
iif( aVal[11] == .t., "S", "N" ) + CRLF + ;
Str( aVal[12], 5 ) + CRLF + ;
iif( aVal[13] == .t., "S", "N" ) ) }

bLee := {|| cMem := MemoRead( CFGAYUDA ), nFilaIni := Val( AllTrim( memoLine( cMem, , 1 ) ) ),;
lPrev := ( AllTrim( memoLine( cMem, , 2 ) ) == "S" ),;
nMargen := Val( AllTrim( memoLine( cMem, , 3 ) ) ),;
nFactor := Val( AllTrim( memoLine( cMem, , 4 ) ) ),;
nFactor := Max( nFactor, 0.20 ), ;
lPrevIni := ( AllTrim( memoLine( cMem, , 5 ) ) == "S" ), ;
lMembr := ( AllTrim( memoLine( cMem, , 6 ) ) == "S" ),;
nVacio := Val( AllTrim( memoLine( cMem, , 7 ) ) ),;
lCuart := ( AllTrim( memoLine( cMem, , 8 ) ) == "S" ),;
nMargend := Val( AllTrim( memoLine( cMem, , 9 ) ) ),;
lSintax := ( AllTrim( memoLine( cMem, , 10 ) ) == "S" ),;
lAcro := ( AllTrim( memoLine( cMem, , 11 ) ) == "S" ), ;
nSalto := Val( AllTrim( memoLine( cMem, , 12 ) ) ), ;
lJustif := ( AllTrim( memoLine( cMem, , 13 ) ) == "S" ) ;
}

Eval( bLee )

aVal := { nFilaIni, lPrev, nMargen, nFactor, lPrevIni, lMembr, nVacio, lCuart, nMargend, lSintax, lAcro, nSalto, lJustif }

aItems := iif( Empty( aItems ), aIt, aItems)

if !File( cFAcro ) //cFile )
Eval( {|| cMemo := '',;
Aeval( aItems, {| c, n | ;
cMemo += ( Trim( aItems[ n ] ) ) + ;
iif( n < Len( aItems ), CRLF, '' ) } ),;
MemoWrit( cFAcro, cMemo ) } )
else
cMemo := MemoRead( cFAcro )
nI := MLCount( cMemo )
// Se lee el archivos de acronomos y textos
For n = 1 to nI
aadd( aItems, ( AllTrim( memoLine( cMemo, , n ) ) ) )
Next
aItems := iif( Empty( aItems ), aIt, aItems )
endif

DEFINE CURSOR oHand HAND
DEFINE FONT oFontW NAME "Arial" SIZE 0, -12 BOLD
DEFINE DIALOG oDlg FROM 1, 01 TO 20, 98 ;
TITLE 'Configuración del Impreso y Texto.' FONT oFontW // OF oWn
oDlg:oCursor := oHand

@ 1, 2.5 GROUP oGr1 TO 7.7, 26.6 PROMPT "Impreso : " OF oDlg FONT oFontW
//@ 1, 27.5 GROUP oGr2 TO 7.7, 52 PROMPT "Texto : " OF oDlg FONT oFontW
@ 1, 27.5 GROUP oGr2 TO 9.7, 52 PROMPT "Texto : " OF oDlg FONT oFontW
@ 1.5, 28 GROUP oGr3 TO 4.1, 51.5 PROMPT "Cargar el Texto : " OF oDlg FONT oFontW
@ 4.2, 28 GROUP oGr4 TO 6, 51.5 PROMPT "Relación de acrónimos y otros : " OF oDlg FONT oFontW

nSalto := iif( nSalto < 1, 15, nSalto )
@ 6.5, 10 BUTTON oBt1 PROMPT "&Aceptar" OF oDlg SIZE 80, 15 ;
ACTION ( aVal := { nFilaIni, lPrev, nMargen, nFactor, lPrevIni, lMembr, nVacio, lCuart, ;




nMargend, lSintax, lAcro, nSalto, lJustif }, ;




Eval( bSave ), oDlg:End() )

oBt1:cToolTip := ;
'Aceptar los valores actuales - ( [Esc.] = Abandonar ).'
oBt1:oCursor := oHand

@ 0, 0 BTNBMP oBmp0 ;
FILE ".\BITMAPS\MIO.bmp" OF oDlg NOBORDER ;
SIZE 14, 14 ACTION MsgInfo( cInfo, "Información" )
oBmp0:cToolTip := 'Información ..'

@ 0, 14 BTNBMP oBmp ;
FILE ".\BITMAPS\WRefresh.bmp" OF oDlg NOBORDER ;
SIZE 14, 14 ACTION ( aVal := { 2, .t., 4, 0.70, .f., .t., 2, .t., 3, .t., .t., 15, .t. }, Eval( bSave ), ;
Eval( bLee ), oK1:Refresh(), oK2:Refresh(), oK3:Refresh(), oK4:Refresh(),;
oK5:Refresh(), oMembr:Refresh() )
oBmp:cToolTip := 'Reiniciar Valores ..'

@ 1.4, 4.2 SAY "Margen superior" //"Linea inicial"
@ 2.4, 3 GET oK1 VAR nFilaIni SIZE 40, 10 PICTURE '99.99' OF oDlg UPDATE ;
SPINNER MIN 0 MAX 70 ON UP Eval( {|| nFilaIni += 0.1, oK1:Refresh() } ) ;
ON DOWN Eval( {|| nFilaIni -= 0.1, oK1:Refresh() } )
oK1:cToolTip := 'Linea de comienzo'

@ 1.4, 20 SAY os1 PROMPT "Margen izquierdo" SIZE 60, 9 //"Columna inicial"
@ 2.4, 15 GET oK3 VAR nMargen SIZE 40, 10 PICTURE '99.99' OF oDlg UPDATE ;
SPINNER MIN 0 MAX 80 ON UP Eval( {|| nMargen += 0.1, oK3:Refresh() } ) ;
ON DOWN Eval( {|| nMargen -= 0.1 }, oK3:Refresh() )
oK3:cToolTip := 'Columnas de margen izquierdo de imprimir.'

@ 4.8, 3.5 CHECKBOX oK2 VAR lPrev PROMPT "Ver &Preimpreso" SIZE 90, 10 OF oDlg ;
ON CHANGE !( lPrev ) //WHEN lActivePrev
oK2:cToolTip := { 'Visualizacion previa S / N', 'Al Imprimir:' }

if lFile .or. lFile2
@ 7, 3.5 CHECKBOX oMembr VAR lMembr PROMPT "&Imprimir con Membrete" SIZE 100, 10 OF oDlg ;
ON CHANGE !( lMembr )
oMembr:cToolTip := 'Imprimir con el membrete del programa.'

@ 5.6, 3.5 CHECKBOX oK5 VAR lPrevIni PROMPT "&Iniciar en Preimpreso" SIZE 100, 10 OF oDlg ;
ON CHANGE !( lPrevIni ) //WHEN lPrev
oK5:cToolTip := 'Iniciar la llamada Previsualizando ..'

@ 6.3, 3.5 CHECKBOX oCuart VAR lCuart PROMPT "&Preimpreso Cuartilla" SIZE 100, 10 OF oDlg ;
ON CHANGE !( lCuart ) //WHEN lPrev
oCuart:cToolTip := 'Al abrir el preimpreso, magnificarlo.'

endif
@ 4, 3.5 CHECKBOX oJustif VAR lJustif PROMPT "&Justificar al imprimir" SIZE 100, 10 OF oDlg ;
ON CHANGE !( lJustif ) //WHEN lYa
oJustif:cToolTip := 'Justificar al imprimir ..'

@ 3.2, 20 SAY os2 PROMPT "Margen derecho" SIZE 60, 9
//if !lYa
oS2:bGotFocus := {|| oS2:nClrText := CLR_WHITE }
//endif
@ 4.5, 15 GET oM4 VAR nMargend SIZE 40, 10 PICTURE '99.99' OF oDlg UPDATE ;
SPINNER MIN 0 MAX 80 ON UP Eval( {|| nMargend += 0.1, oM4:Refresh() } ) ;
ON DOWN Eval( {|| nMargend -= 0.1, oM4:refresh() } ) //WHEN lYa
oM4:cToolTip := 'Margen derecho ' + ;
'al imprimir.'

@ 5, 20 SAY os3 PROMPT "Porcentaje %Fuente" SIZE 60, 9
@ 6.6, 15 GET oK4 VAR nFactor SIZE 40, 10 PICTURE '99.99' OF oDlg UPDATE ;
SPINNER MIN 0.10 MAX 2.00 ON UP Eval( {|| nFactor += 0.01, oK4:Refresh() } ) ;
ON DOWN Eval( {|| nFactor -= 0.01, oK4:refresh() } )
oK4:cToolTip := { 'Porcentaje a aplicar a las fuentes' + ;
'para optimizar impresión.',

'Impresos:' }

@ 2.5, 30 CHECKBOX oSintax VAR lSintax PROMPT "En minúsculas con &Sintáxis" SIZE 130, 10 OF oDlg ;
ON CHANGE !( lSintax ) WHEN ( lFile .or. lFile2 )
oSintax:cToolTip := { 'En minúsculas excepto después de punto.', 'Al cargar texto:' }

@ 3.3, 30 CHECKBOX oAcro VAR lAcro PROMPT "Ver &Acrónimos y otros en mays." SIZE 130, 10 OF oDlg ;
ON CHANGE !( lAcro ) WHEN ( lFile .or. lFile2 )
oAcro:cToolTip := { 'Acrónimos y otros textos en mayúsculas.', 'Al cargar texto:' }

@ 3.9, 36 BUTTON oB5 PROMPT "&Ver / modificar lista .." OF oDlg SIZE 120, 08 ;
WHEN ( lFile .or. lFile2 ) ACTION MemoWrit( cFAcro, ; //cFile
MemoEdi2( MemoRead( cFAcro ), , , , , "Editando la Lista de textos.", .f. ) )

ob5:cToolTip := 'Ver / Mofificar el' + CRLF + ;
'Archivo de la Lista..'
ob5:oCursor := oHand

@ 5, 33 BUTTON oB6 PROMPT "&Font de nombre del paciente, en informes y recetas" OF oDlg SIZE 160, 08 ;
WHEN ( lFile .or. lFile2 ) ACTION FNameFon( oFont, nColor )

ob6:cToolTip := { 'Aplicar una fuente y color ' + ;
'al imprimir la primera línea con ' + ;
'el nombre del paciente', 'En informes y recetas' }
ob5:oCursor := oHand

@ 6.9, 33 SAY os7 PROMPT "Salto de la rueda del ratón" SIZE 90, 9
@ 8.9, 24.9 GET oK7 VAR nSalto SIZE 55, 10 PICTURE '99' OF oDlg UPDATE ;
SPINNER MIN 1 MAX 30 ON UP Eval( {|| nSalto += 1, oK7:Refresh() } ) ;
ON DOWN Eval( {|| nSalto -= 1, oK7:refresh() } )
oK7:cToolTip := { 'Cuantas linea saltar con la rueda' + ;
' (aconsejable 15).', 'Ratón:' }


ACTIVATE DIALOG oDlg CENTERED VALID ( Eval( bSave ), Eval( bLee ), .t. )
oFontW:End()

Return aVal
*----------

Static Function FNameFon( oFont, nNewColor )
local cFileFont := "NameFONT." + cExt, cFileColr := "NameCOLR." + cExt
local aFon, aModel := { -21, 0, 0, 0, 700, .t., .f., .f., 0, 3, 2, 1, 82, 'Curlz MT' }, bParamFont
local oNewFont := oFont
local cFon := "", bSave
local bLoad
DEFAULT nNewColor := nColor
DEFINE FONT oNewFont NAME "Arial" SIZE 0, -12 BOLD ITALIC


bParamFont := {|| iif( !Empty( aFon ), ( ;
iif( !Empty( oNewFont ), oNewFont:End(), Nil ), ;
oNewFont := TFont():New( aFon[14],;
aFon[02], aFon[01], .f., ;
! ( aFon[05] == 400 ), aFon[03], ;
aFon[04], aFon[05], ;
aFon[06], aFon[07], ;
aFon[08], aFon[09], ;
aFon[10], aFon[11], ;
aFon[12] ) ) , aFon := aModel ) }
// Eval( {||oNewFont:Litalic := .t.} )
cFon := ""
bSave := { || cFon := "", aEval( aFon, {| c, n | cFon += cValToChar( aFon[ n ]) + CRLF } ), ;
Memowrit( cFileFont, cFon ), Memowrit( cFileColr, AllTrim( Str( nNewColor ) ) ) }

bLoad := {|| nNewColor := Val( MemoRead( cFileColr ) ),;
cFon := Memoread( cFileFont ), ;
Iif( MLCount( cFon ) > 0, ;
( aFon := Array( 14 ), ; //MLCount( cFon ) )
aEval( aFon, { | c, n | ;
aFon[n] := uCharToVal( AllTrim( Memoline( cFon,, n ) ), aModel[n] ) } ) ;
), aFon := aModel ), ;
iif( !Empty( aFon ), Eval( bParamFont ), Nil ) }

Eval( bLoad )

nNewColor := Val( MemoRead( cFileColr ) )

aFon := ChooseFont( ; //GetFonColor() //oNewFont:Choose() // @nNewColor )
{ oNewFont:nInpHeight, oNewFont:nInpWidth, oNewFont:nEscapement,;
oNewFont:nOrientation, oNewFont:nWeight, oNewFont:lItalic,;
oNewFont:lUnderLine, oNewFont:lStrikeOut, oNewFont:nCharSet,;
oNewFont:nOutPrecision, oNewFont:nClipPrecision,;
oNewFont:nQuality, oNewFont:nPitchFamily, oNewFont:cFaceName },;
@nNewColor )

Eval( bSave )
oNewFont:End()

Return nil

//-------------
Static Function Actual()
local oAct

Define Window oAct TITLE "Leyendo: RESOLUCION"
nAH := oAct:nHorzRes()
nAV := oAct:nVertRes()

Activate Window oAct ON INIT ( oAct:Hide(), msginfo( "Establecer Coordenadas óptimas..", ;
"Resolución: " + Alltrim( Str( nAH ) ) + " x " + Alltrim( Str( nAV ) ) ), oAct:End() )

Return nil

//-------------

//----------------------------------------------------------------------------

procedure AppSys // Xbase++ requirement

return

//----------------------------------------------------------------------------//
***************************************************-------
function membrete( oPr, oFon, oWn, cBase, lVacio, cMemb, lSuper, nMargen, nFilas, nCols, nFilaIni )
***************************************************-------
local cText := '', bqi := 0, nI := 0, aAreas := aGetWorkAreas()
local nArea := SELECT(), cAreaUso := ALIAS( nArea )
LOCAL recit, nRow := 1, nCol := 1, nColStep, nChar, aTypes
local nAncho := oFon:nWidth, Alto := oFon:nHeight
local oFon1, oFon2, oFon3, oBmp, cFileName := '', nZoom, Anchura, Altura
local nRatAlto, nRatAncho, nSize := 1, nCampos
local mcategoria, mempresa, mpueblo, mpuebla, mtelef, mdpostal, msenas
local mnif, mClave, busc_inicio, colega1, colega2, colega3, colega4
local nC := 1, nR := 5, cFileBmp := '', cFileSpec := '', ;
lMemb := !( Empty( cMemb ) )
local nCol2 := 1, nColumnas := 1, nResHz := 1, cFBmps
local xLin, xCol, bFile, bLoadVal, aCol, aLin, aFn, aCl, nCW, ;
cFileFn, cFileCl, bxy, lFont, cFLin, cFCol, nPl, nPc
local aFon, cFon, bFntLoad, bColrLoad, bParamFont, bFont, nColor := 0
local cExt := PADL( AllTrim( str( Lis_Red->( RecNo() ), 3 ) ), 3, "0" )
local cFileNm := 'BMPS.' + cExt, lBmps := .f.
local nXR := 292, nXC := 203,; //Size vert y Horiz de referencia de progrcion
nX, nY // de la HP PSC 1610
local lBitmap := .f. // Imprimir segun bitmap NO Image
local oGScal, nScal := 1, cFScal := "LIN" + cMemb + "SCAL." + cExt
local cFLf := "LIN" + cMemb + "INIF." + cExt, ;
cFLc := "LIN" + cMemb + "INIC." + cExt
local oGLf , nLF := 0, lChLf := .f.
local oGLc , nLc := 0, lChLc := .f.
local cFChPrn, lChPrn, aLChPrn := {}, xChn, aLc, nVac

DEFAULT lSuper := .f. //Obliga a impr las pruebas de editmembrete
//aunque este en seleccion de saltar membrete

nScal := iif( File( cFScal ), Val( AllTrim( MemoRead( cFScal ) ) ), nScal )
nLf := iif( File( cFLf ), Val( AllTrim( MemoRead( cFLf ) ) ), nLf )
nLc := iif( File( cFLc ), Val( AllTrim( MemoRead( cFLc ) ) ), nLc )

cFileNm := iif( cMemb == 'B', 'BMPX.' + cExt, cFileNm )

cFileSpec := "MBTTXT." + ; // LINEAS TEXTO P. MEMBRETE ESPECIAL PERSONALIZADO
PADL( AllTrim( str( Lis_Red->( RecNo() ), 3 ) ), 3, "0" )
cFileBmp := AllTrim( MemoRead( cFileNm ) )
cFileName := cFileBmp
cFBmps := 'cFBmps.' + cExt
lBmps := ( File( cFBmps ) .and. File( cFileBmp ) )
lBmps := iif( Empty( cFileBmp ), .f., lBmps )

//cFileBmp := iif( Empty( cFileBmp ), ".\bitmaps\Mbt001.Bmp", cFileBmp )
if lBmps .and. !File( cFileBmp )
MsgAlert( 'Archivo: ' + cFileBmp + CRLF + ;
'NO Encontrado ..!', 'Atención !' )
// Ferase( cFileNm )
lBmps := .f.
endif
DEFAULT oWn := GetWndDefault()
DEFAULT cBase := ''
DEFAULT lVacio:= .f.
//DEFAULT cMemb := 'X'
membr0 := {}
membr1 := {}
membr2 := {}

//oWnd := oWn
//oWn := Nil
oPrn := oPr

//cTitular := FTitular() // Se lee de wocul3.prg, cTitular es estatica del .prg
// El membrete q se esta dise¤ando es el personalizado para cada usuario...

if ASCAN( aAreas, { |x| Upper(x) $ 'CONTROL' } ) > 0
cTitular := AllTrim( OemToAnsi( Control->Categoria ) ) + cTitular
else
DbUseArea( .t., , "CONTROL", , .t. ) // modo compartido
//usa_base( "CONTROL", .f., "", 5, .t. ) // Lee valores membrete general
cTitular := AllTrim( OemToAnsi( Control->Categoria ) ) + cTitular
( 'Control' )->( DbCloseArea() )
if !Empty( cAreaUso )
DbSelectArea( cAreaUso )
endif
endif

DbSelectArea( 'Lis_red' )
recit := Upper( Left( ( sClave ), 01 ) ) // sClave es estatica
//recit := Upper( Left( ( Lis_red->Clave4 ), 01 ) )
//nUsuario := Lis_red->( RecNo() )
cMemb := iif( lMemb, cMemb, Recit )
nVac := at( Recit, '123456789' ) // Saltar el membrete y poner cuantas líneas - si nVac > 0

// Las 5 lineas de nombre de Dr ¢ Centro: negra, cursiva, algo menos tama¤o

DEFINE FONT oFon1 NAME "Arial" SIZE 16, 7 OF oPrn BOLD ITALIC //0, -8 OF oPrn BOLD ITALIC
DEFINE FONT oFon2 NAME "Arial" SIZE 0, -10 OF oPrn BOLD ITALIC
DEFINE FONT oFon3 NAME "Arial" SIZE 0, -9 OF oPrn BOLD ITALIC
DEFINE FONT oFonSpec NAME 'Arial' SIZE 6, 13 OF oPrn

nLf *= oPrn:nVertRes()/70 // Ponemos 70 lineas para la pagina
nLc *= oPrn:nHorzSize()/80 // de imagen, y 80 columnas


nColumnas := INT( oPrn:nHorzRes() / 80 * 3 )
// en los BMPs 3 columnas libres de margen izq., para un total de 80

// DEFINE BITMAP oBmp FILENAME cFilename //OF oWnd

DEFINE IMAGE oBmp FILENAME cFileBmp //cFilename //OF oWnd

// oBmp := DefImage( cFileName )
// oBmp := DefBmp( cFileName )
nZoom:=oBmp:Zoom()
anchura:=oBmp:nWidth()*nZoom
altura :=oBmp:nHeight()*nZoom

nRatAncho := 3.80
nRatAlto := 3.80

nXr := nXR/oPrn:nVertSize() // se crea asi factor de normalizacion
nXC := nXC/oPrn:nHorzSize() // p q funcione igual en otras impresoras

nX := oPrn:nVertRes()/oPrn:nHorzRes()
nX := oPrn:nVertSize()/oPrn:nHorzSize()
nY := altura/anchura
anchura := nScal*nXR*oPrn:nHorzSize()/80*anchura*nX*2*0.86 //10 //oImage:nWidth()*nZoom
altura := nScal*nXC*oPrn:nVertSize()/80*altura*2*0.86 //10 //oImage:nHeight()*nZoom

// Altura := INT( nRatAlto * Altura * nSize )
// Anchura := INT( nRatAncho* Anchura* nSize )
nColumnas := INT( oPrn:nHorzRes() / 80 * 3 )
// 3 columnas libres de margen izq., para un total de 80


DO CASE // Selecciona el membrete por configuracion
// para cada clave de acceso
CASE lSuper == .f. .and. ;
AT( RECIT, '0123456789' ) > 0 //.or. Val( Recit ) > 0
// SE ELIGIO SALTAR EL MEMBRETE
nRow += Alto*( val( recit ) ) // Lineas a saltar membrete

CASE RECIT == 'B' .or. cMemb == 'B'
// 'Membrete.bmp' // El modelo de mi nombre
lBmp := .t. // Estatica del .prg
cFileName := '.\bitmaps\Memb' + ;
+ PADL( AllTrim( str( nUsuario, 4 ) ), 4, "0" ) + '.Bmp'

// El membrete de Bitmaps se prepara para cada clave de usuario
if !File( cFileName ) .and. File( '.\bitmaps\Memb0001.Bmp')
LZCopyFile( '.\bitmaps\Memb0001.Bmp', cFileName )
endif

if File( cFilename )

oPrn:SayImage( nLf, nLc, obmp, anchura, altura )

/* // Prueba posibles 2 Bmp, derecho e izq. ..?
cFileName := '.\bitmaps\Memb' + 'd001.bmp'
PrnArgon( cFileName, nR + 1*xR, nC + 1*xC, .f., 1, xBH, xBV )
cFileName := '.\bitmaps\Memb' + 'i001.bmp'
PrnArgon( cFileName, nR + 1*xR, oPrn:nHorzRes()/80*60, .f., 1, xBH, xBV )
*/
nRow += altura

oBmp:End()

else
MsgInfo( 'Membrete: ' + cFileName + CRLF + 'No encontrado' + CRLF +;
'Se saltaran sus líneas', 'Información' )
nRow += Alto*( val( recit ) ) // saltara el membrete .bmp no hallado ..
endif

nRow := Alto*9 // Linea a empezar textos

CASE cMemb == 'P' .or. cMemb == 'S' .or. Empty( cMemb )
//.or. RECIT == 'P' .OR. RECIT == 'S' .OR. EMPTY( RECIT )
// MEMBRETE PERSONALIZADO PARA CADA CLAVE DE ACCESO
// O MEMBRETE GENERAL
DbUseArea( .t., , "CONTROL", , .t. ) // modo compartido
// usa_base( "CONTROL", .f., "", 5, .t. ) // Lee valores membrete general
mnif := AllTrim( Control->nif )

//If Recit == 'P' .or.
IF cMemb == 'P' // MEMBRETE PERSONALIZADO PARA CADA CLAVE DE ACCESO

// Se leen los datos en campos del registro de lis_red
// de la clave de acceso, para cada usuario

// aqui la linea primera de cabecera = campo 9
// las 5 lineas de nombres de doctor ¢ centro.
// Campos = 10, 11, 12, 13 y 14
for nCampos := 9 to 14
aadd( membr0, trim( substr( Lis_red->( fieldget( nCampos ) ), 11 ) ) )
next

// aqui las lineas 7,8,9,10,11,12 de datos del doctor
// Campos 15 al 20 ambos inclusive
for nCampos := 15 to 20
aadd( membr1, trim( substr( Lis_red->( fieldget( nCampos ) ), 11 ) ) )
next

// 13,14,15,16,17,18 por la derecha de datos de direccion, telef, etc..
// Campos 21 al 26 ambos inclusive
for nCampos := 21 to 26
aadd( membr2, Ltrim( substr( Lis_Red->( fieldget( nCampos ) ), 11 ) ) )
next



Else // O MEMBRETE GENERAL -> se leen los datos en Control.dbf



//cTitular := AllTrim( Control->Titular )
mempresa := AllTrim( Control->empresa )
mpueblo := Control->pueblo
mtelef := AllTrim( Control->telef )
mdpostal := AllTrim( Control->dpostal )
msenas := AllTrim( Control->senas )
mClave := AllTrim( str( Control->clave ) )
busc_inicio:= Control->ocultar

mpuebla := AllTrim( mpueblo ) + IIF( !Empty( mdpostal ), ;
' - ' + Trim( mdpostal ), '' )
DbUseArea( .t., , "ANAL", , .t. ) // modo compartido
// usa_base( "ANAL", .f., "", 5, .t. )

aadd( membr0, '' ) // Aqui no hay linea superior al nombre del doctor

// Bloque con el nombre de los doctores
//aadd( membr0, AllTrim( Control->Titular ) ) // El doctor
aadd( membr0, AnsiToOem( cTitular ) ) // El doctor
// Campos 2 a 5 ambos inclusive, de anal.dbf
for nCampos := 2 to 5
aadd( membr0, OemToAnsi(AllTrim( Anal->( fieldget(nCampos) ) )) ) // Otros colegas
next

( "ANAL" )->( DbCloseArea() )

DbSelectArea( 'Lis_red' ) // Se repone la seleccion de area

// Bloque derecho, datos ..
aadd( membr1, '' ) // Se respeta una linea a este lado, bloque dcho membrete
aadd( membr1, mempresa ) // Medico Oftalmologo 2¦ linea
if Val( mClave ) > 0
// si el num colegiado existe, ponerlo, si no omitirlo
// pues seria una entidad no un medico
aadd( membr1, ( "Colegiado N§. " + mClave ) ) // 3¦ linea
else
aadd( membr1, "" ) // 3¦ linea
endif
aadd( membr1, '' ) // Se igualan lineas a este lado
aadd( membr1, '' ) // Se igualan lineas a este lado
aadd( membr1, '' ) // Se igualan y esta es la seis ..

// Bloque izquierdo ... se¤as..
aadd( membr2, Trim( msenas ) ) // primera linea del bloque izquierdo del membrete
if !empty( mtelef )
aadd( membr2, "Tlf: " + Trim( mtelef ) )
// 3¦ linea del bloque izquierdo del membrete
else
aadd( membr2, "" ) // 3¦ linea del bloque izquierdo del membrete
endif
aadd( membr2, mpuebla ) // 2¦ linea del bloque izquierdo del membrete
aadd( membr2, '' ) // Se igualan lineas a este lado
aadd( membr2, '' ) // Se igualan lineas a este lado
aadd( membr2, '' ) // Se igualan y esta es la seis ..


Endif // FFFFIIIIIINNNNNNNN
// FIN de creacion arrays para membrete personal o general

( "Control" )->( DbCloseArea() )

if lBmps .and. cMemb == 'P' .or. cMemb == 'S' .and. ;
MemoRead( "SNBMP." + cExt ) != "N"
// Se imprime el BitMap si existe, a¤adido a texto..
// y en memb gral si se desea

oBmp := DefImage( cFileBmp ) // Se crea el objeto de imagen, oBmp
oPrn:SayImage( nLf, nLc, obmp, anchura, altura, )
oBmp:End()
endif

// IMPRIMIR EL MEMBRETE DE LINEAS DE TEXTO ..PERSONAL O GENERAL.
bLoadVal := {|| ;
xChn := ( AllTrim( Upper( MemoRead( cFChPrn ) ) ) != ;
'N' .or. cMemb == 'S' ), ;
xLin := Val( MemoRead( cFLin ) ), ;
xCol := Val( MemoRead( cFCol ) ) }
bFile := {| nPar | ;
cFChPrn := "LI" + Padl( lTrim( str( nPar, 2 ) ), 2, "0" ) + ;
"CHPR." + cExt, ;
cFileFn := "LI" + Padl( lTrim( str( nPar, 2 ) ), 2, "0" ) + ;
"FONT." + cExt, ;
cFileCl := "LI" + Padl( lTrim( str( nPar, 2 ) ), 2, "0" ) + ;
"COLR." + cExt, ;
cFLin := "LI" + Padl( lTrim( Str( nPar, 2 ) ), 2, "0" ) + ;
"ROW." + cExt, ;
cFCol := "LI" + Padl( lTrim( Str( nPar, 2 ) ), 2, "0" ) + ;
"COL." + cExt, lFont := File( AllTrim(cFileFn) ) .or. ;
File( AllTrim(cFileCl) ),;
xChn := ( AllTrim( Upper( MemoRead( cFChPrn ) ) ) == 'S' ) .or. ;
( !File( cFChPrn ) ) }

aLc := {}
aFn := {}
aCl := {}
aLin := {}
aCol := {}

For nI := 1 To 18
Eval( bFile, nI )
Eval( bLoadVal )
aadd( aLc , xChn )
aadd( aFn , iif( Upper(cMemb) == 'P', cFileFn, 'PPPPPPPPx' ) )
aadd( aCl , iif( Upper(cMemb) == 'P', cFileCl, 'PPPPPPPPx' ) )
aadd( aLin, xLin )
aadd( aCol, xCol )

Next

nPc := oPrn:nHorzRes()/80 // 80 Columnas
nPl := oPrn:nVertRes()/70 // 70 Lineas
bxy := { | nPar | ;
Eval( bFile, nPar ), ;
Eval( bLoadVal ), ;
iif( cMemb == 'P' .and. ;
File( AllTrim(cFLin )) .and. ;
File( AllTrim(cFCol) ), ;
( xLin := int(aLin[nPar]*nPl), ;
xCol := int(aCol[nPar]*nPc) ), ;
( xLin := nRow, xCol := nCol ) ), ;
Eval( bFntLoad, AllTrim(aFn[nPar]) ), Eval( bParamFont ), ;
iif( !( lColor ), nColor := 0, ;
Eval( bColrLoad, aCl[nPar] ) ) }
bColrLoad:= ;
{| FprntColr | nColor := Val( AllTrim( Memoread( FPrntColr ) ) ) }
oFonSpec := oFon

//aTypes := { -12, 0, 0, 0, 700, .t., .f., .f., 0, 3, 2, 1, 0, 'System' }
aTypes := { -12, 0, 0, 0, 700, .t., .f., .f., 0, 0, 0, 0, 0, 'Omision' }

bFntLoad := {|FPrntFont| cFon := AllTrim( Memoread( FPrntFont ) ), ;
Iif( MLCount( cFon ) > 0, ;
( aFon := Array( 14 ), ;
aEval( aFon, { | c, n | aFon[n] := AllTrim(Memoline( cFon,, n )), ;
aFon[n] := uCharToVal( AllTrim( aFon[n] ), aTypes[n] ) } ) ), ;
aFon := aTypes ),; // }
iif( !Empty( aFon ), Eval( bParamFont ), Nil ) }

bParamFont := {|| iif( !Empty( aFon ), ( ;
iif( !Empty( oFonSpec ), oFonSpec:End(), Nil ), ;
oFonSpec := TFont():New( aFon[14],;
aFon[02], aFon[01], .f., ;
! ( aFon[05] == FW_NORMAL ), aFon[03], ;
aFon[04], aFon[05], ;
aFon[06], aFon[07], ;
aFon[08], aFon[09], ;
aFon[10], aFon[11], ;
aFon[12], oPrn ) ), Nil ) }

// Imprimir la primera linea en caracteres normales
nRow += oFon2:nHeight
if !Empty( membr0[ 1 ] ) .and. alC[ 1 ] == .t.
Eval( bxy, 01 )
oPrn:Say( xLin, xCol, Trim( OemToAnsi( membr0[ 1 ] ) ), iif( ;
!File( AllTrim(aFn[01]) ), oFon, oFonSpec ), , nColor ) // Font en uso
nRow += oFon:nHeight
endif

nColStep = oPrn:nHorzRes() / 80 //oFon3:nWidth // Num. de columnas
nResHz := iif( !Empty( oWnd ), oWnd:nHorzRes() / oPrn:nHorzRes(), 1 )
//nCol := 80*xC // esta es la buena ..
for bqi := 2 to 6 // Nombre del Dr y otras, son 5 lineas
if !Empty( membr0[ bqi ] ) .and. alC[ bqi ] == .t.
nCol := 4*oFon3:nWidth + ;
oFon3:nWidth * ( len( membr0[ bqi ] ) - ;
( len( ltrim( membr0[ bqi ] ) ) ) )*0.3
Eval( bxy, bqi )
oPrn:Say( xLin, xCol, Trim( OemToAnsi( membr0[ bqi ] ) ), ;
iif( !File( AllTrim(aFn[bqi]) ), oFon2, oFonSpec ), , nColor )
nRow += oFon2:nHeight
endif
next

for bqi = 1 to 6
nCol2 := MAX( nCol2, Len( membr2[ bqi ] ) )
next

nCW := oPrn:nHorzRes()/80
// 6 Lineas izq. y dcha membrete: negra condensada
nI := Len( membr1 ) // 6 ¢ 7, si es factura ( Nif )
for bqi = 1 to nI // se imprimen las lineas con contenido solamente
if !empty( membr1[ bqi ] + membr2[ bqi ] )

nCol := 4*nCW //4*oFon3:nWidth + ;
//oFon3:nWidth * ( len( membr1[ bqi ] ) - ;
// ( len( ltrim( membr1[ bqi ] ) ) ) )*0.3

Eval( bxy, bqi + 6 )
if alC[ bqi +6 ] == .t.
// Columna dcha. membrete
oPrn:Say( xLin, xCol, Trim( OemToAnsi( membr1[ bqi ] ) ), ;
iif( !File( AllTrim(aFn[bqi+6]) ), oFon3, oFonSpec ), , nColor )
endif

nCol := ( nCW*75 - ; // en memb gral margen dcho de 5 cols
oPrn:GetTextWidth( membr2[ bqi ], oFon3 ) )

if alC[ bqi +12 ] == .t.
// Columna izq. membrete, ajustandolo
oPrn:SetPos( nRow, nCol )
Eval( bxy, bqi + 12 )
oPrn:Say( xLin, xCol, Trim( OemToAnsi( membr2[ bqi ] ) ), ;
iif( !File( AllTrim(aFn[bqi+12]) ), oFon3, oFonSpec ), , nColor )
endif

nRow += oFon3:nHeight + 3
endif
next

nRow := nFilaIni + 10*nFilas
nCol := nMargen + nCols*2

if !Empty( mNombre )
cFileFn := "NameFONT." + cExt ; cFileCl := "NameCOLR." + cExt
Eval( bColrLoad, cFileCl )
Eval( bFntLoad, cFileFn )
oPrn:Say( nRow, nCol, 'Paciente: ' + mNombre, oFonSpec,, nColor )
nCol := nCW*71 - oPrn:GetTextWidth( DtoC( Date() ), oFonSpec ) //oFon3
oPrn:Say( nRow, nCol, DtoC( Date() ), oFonSpec,, nColor )
nRow += 1*nFilas //3*( oFon2:nHeight + 3 )
endif

ENDCASE

oFon1:End()
oFon2:End()
oFon3:End()
oFonSpec:End()

return( nRow )
*-------------
Function DefImage( Bmp )
Return TImage():Define( , Bmp )


static function MenuRadio( cMsg, aOpc, cTit, nValue )
*************************************
local oRad, oWnd2, oBot1, aLista := Array( 3 )
local lValor := .f., n := 0

DEFAULT cMsg := 'Valores: '
DEFAULT aOpc := { 'Si', 'No', 'Ignorar' }
DEFAULT cTit := 'Elija, por favor..'
DEFAULT nValue := 1

// aLista := Array( Len( aOpc ) )
aLista := AFill( aLista, '' )
for n := 1 to len( aOpc )
aLista[n] := OemToAnsi( aOpc[n] )
next

DEFINE DIALOG oWnd2 FROM 01, 01 TO 14, 65 ;
TITLE cTit //COLOR "N/W"

@ 0.4, 1 BUTTON oBot1 PROMPT "&Aceptar" SIZE 40, 12 OF oWnd2 ;
ACTION oWnd2:End()

@ 1.5, 1 TO 6, 35 LABEL cMsg OF oWnd2
// oRad := TRadMenu():New( 2.3, 2, aLista, nValue ) //,,,,,, cMsg )

@ 2.3, 2 RADIO oRad VAR nValue OF oWnd2 ;
PROMPT aLista[1], aLista[2], aLista[3] //, aLista[4]

ACTIVATE DIALOG oWnd2 CENTER

return nValue
*------------
*
function MemoEdi2( cText, nTop, nLeft, nBottom, nRight, cTitle, lRead )

local oDlg2, oMemo, lAcept := .f., cMemo := cText // Respaldo ..
local oBAcept, oBCancel

DEFAULT nTop := 3, nLeft := 5, nBottom := 30, nRight := 70,;
cTitle := "Memo Editor", cText := space(500), lRead := .t.
cTitle := cTitle + iif( lRead, " - Solo Lectura.", "" )
nXtr := nXtC := 1
DEFINE DIALOG oDlg2 FROM nTop, nLeft TO nBottom, nRight + 1 TITLE cTitle

@ 0, 0 GET oMemo VAR cText MEMO ; //READONLY
OF oDlg2 SIZE ( nRight - nLeft ) * 4, ( nBottom - nTop ) * 6
oMemo:LimitText()
oMemo:lReadOnly := lRead
oMemo:bGotFocus := {|| oMemo:SetSel( 0, 0 ) }
oMemo:cToolTip := 'Texto: ' + iif( lRead, 'Solo LECTURA ..', ;
'Editando ...' )

@ 10, 8 BUTTON oBAcept PROMPT "&Aceptar" OF oDlg2 SIZE 50, 10 ;
ACTION ( lAcept := .t., oDlg2:End() )
oBAcept:cToolTip := 'Aceptar texto y Salir ..'

@ 10, 18 BUTTON oBCancel PROMPT "A&bandonar" OF oDlg2 SIZE 50, 10 ;
ACTION ( lAcept := .f., oDlg2:End() )
oBCancel:cToolTip := 'Abandonar si se han efectuado cambios.'

ACTIVATE DIALOG oDlg2 // CENTERED

return iif( lAcept, cText, cMemo )
//---------------------------------

function uCharToVal( cValue, uType )

local cType := ValType( uType )
local uResult

do case
case cType == "C"
uResult = cValue

case cType == "N"
uResult = Val( cValue )

case cType == "D"
uResult = CToD( cValue )

case cType == "L"
uResult = ( cValue == ".T." )
endcase

return uResult

Static Function ShowP( nRow, nCol, oGet )
Local oMenuP
local lFocus := oGet:lFocusBlock
local cTextForm := oGet:GetBlock() // Lee todo lo q se selecciona cada vez
local lSel := !Empty( cTextForm)
local oU, oCr, oCp, oPegar, oBo, oSe, oBu, oSi, oFu, oAl

MENU oMenuP POPUP 2007
if lAct
MENUITEM oU PROMPT "&Deshacer" ACTION ( ;
iif( !(lAct), MsgWait( "No hay cambios a deshacer", "Deshacer" ), ( oGet:UnDo(), ;
lChange := .t. ) ) )
else
MENUITEM oU PROMPT "&Deshacer" ACTION ( ;
iif( !(lAct), MsgInfo( "No hay cambios a deshacer", "Deshacer" ), ( oGet:UnDo(), ;
lChange := .t. ) ) ) DISABLED
endif

SEPARATOR
IF lSel
MENUITEM oCr PROMPT "Cor&tar" ACTION iif( oGet:lBlock, ( oGet:Cut(), lChange := .t., lAct := .t. ), ;
MsgStop( "No hay texto seleccionado", "Atención" ) )
else
MENUITEM oCr PROMPT "Cor&tar" ACTION iif( oGet:lBlock, ( oGet:Cut(), lChange := .t., lAct := .t. ), ;
MsgStop( "No hay texto seleccionado", "Atención" ) )

DISABLED
endif
If lSel
MENUITEM oCp PROMPT "&Copiar" ACTION iif( oGet:lBlock, ( oGet:Copy(), lChange := .t., lAct := .t. ), ;
MsgStop( "No hay texto seleccionado", "Atención" ) )
else
MENUITEM oCp PROMPT "&Copiar" ACTION iif( oGet:lBlock, ( oGet:Copy(), lChange := .t., lAct := .t. ), ;
MsgStop( "No hay texto seleccionado", "Atención" ) ) DISABLED
endif

if lSel
MENUITEM oPegar PROMPT "&Pegar" ACTION ( oGet:Paste(), lChange := .t., lAct := .t. )
else
MENUITEM oPegar PROMPT "&Pegar" ACTION ( oGet:Paste(), lChange := .t., lAct := .t. ) DISABLED
endif
IF lSel
MENUITEM oBO PROMPT "B&orrar" ACTION ( oGet:Del(), lChange := .t., lAct := .t. )
else
MENUITEM oBO PROMPT "B&orrar" ACTION ( oGet:Del(), lChange := .t., lAct := .t. ) DISABLED
endif
SEPARATOR
MENUITEM "&Imprimir Documento" ACTION Imprimir( oGet, cFileDisc, oFont, nColor )
SEPARATOR
MENUITEM oSe PROMPT "Se&leccionar todo" ACTION ( oGet:SelectAll() ) //, oGet:Copy() )
//SetFClipData( oGet:hWnd, "", cTextFormat, GTFToRTF( cTextFormat ) ) ) // vaciarlo ?
SEPARATOR
MENUITEM oBu PROMPT "&Buscar texto" ACTION Find()
MENUITEM oSi PROMPT "&Siguiente" ACTION FindNext()
// ENDMENU

// MENUITEM "Fuentes"
// MENU

// MENUITEM "&Color" ACTION ( oGet:GetColor(), lChange := .t., lAct := .t. )
if lSel
MENUITEM oFu PROMPT "&Fuente" ACTION ( oGet:GetFontColor(), lChange := .t., lAct := .t. )
else
MENUITEM oFu PROMPT "&Fuente / color" ACTION ( oGet:GetFontColor(), lChange := .t., lAct := .t. ) DISABLED
endif
// ENDMENU

MENUITEM oAl PROMPT "Alinear"
MENU
MENUITEM "Alinear a la Izquierda" ACTION ( oGet:SetAlign( ES_LEFT ), lChange := .t., lAct := .t. ) //MemoWrit( aFiles[

nItem ], cText ))
MENUITEM "Alinear a la Derecha" ACTION ( oGet:SetAlign( ES_RIGHT ), lChange := .t.,lAct := .t. ) //,MemoWrit(

aFiles[ nItem ],cText ))
MENUITEM "Centrada" ACTION ( oGet:SetAlign( ES_CENTER ), lChange := .t., lAct := .t. ) //,MemoWrit( aFiles[

nItem ], cText ))

//MENUITEM "Justificar" ACTION ( ; //oLine := oGet:oLine, oGet:GetDC()
//oGet:LineAdjust( oGet:oLineInit, oGet:oLineEnd ) ) // MemoWrit( aFiles[ nItem ], cText ))
//? oGet:WidthLine( oLine ), Eval( oGet:nWidth )
ENDMENU
ENDMENU

ACTIVATE POPUP oMenuP WINDOW oWnd AT nRow, nCol

Return oMenuP //Nil //MsgInfo( oMenuP )

function spanish( cName, lMays )

local nResp := 0, buscar, poner, cadena

default lMays := .f.
if lMays
buscar := Chr(164)
poner := Chr(165) // pasar a mayuscula la Ñ
else
buscar := Chr(165)
poner := Chr(164) // pasar a minuscula la Ñ
endif
buscar := Chr(165)
poner := Chr(164) // pasar a minuscula la Ñ
cadena := cName

do while !Empty( cadena) .and. at( buscar, cadena ) > 0 // La e¤e
nResp := at( buscar, cadena )
cadena := iif( nResp > 0, stuff( cadena, nResp, 1, poner ), cadena )
enddo
//? OemToAnsi( cadena )
return( cadena )
//---------------

Function Seleccion( nVal, oFontx, nColorx )
local oLine := oGet:oLine, n1, n2
local aAlign := { "IZQUIERDA", "CENTRAR", "DERECHA" }
local nLine := oGet:nLineRow
local cInfo := "", cChars := "", nI := 1, cTc := "", cAct
local lFocus := .f.
local cTextForm := ""
local nCrLf := 0
local nCol := oGet:nLineCol + 1
local cLinea := oGet:GetTextLine( oLine ), oClp

DEFAULT nVal := 1
oGet:GetDC()
if oGet:lBlock
cTextForm := oGet:GetBlock()
nCrLf := At( CRLF, cTextForm )
lFocus := oGet:lFocusBlock
cChars:= cTextForm // es lo mismo y no tengo que cambiar el texto
else
MsgWait( "No hay Texto seleccionado", "Atención", 0.8 )
Return Nil
endif

if Len( cTextForm ) > 30000
MsgInfo( "Actual: " + AllTrim( sTr(Len( cTextForm )) ) + " b." + CRLF + ;
"Seleccione bloques de texto mas" + CRLF + ;
"pequeños, unas 10 páginas cada" + CRLF + ;
"vez, aproximadamente.", "Por favor.." )
Return Nil
Endif
/*
cTextForm := iif( Len( cTextForm ) == nCrLf + Len( CRLF ), ;
Stuff( cTextForm, nCrLf, 2, "" ), cTextForm )
cChars := GTFToTxt( cTextForm )
SetFClipData( oGet:hWnd, cChars, cTextForm, GTFToRTF( cTextForm ) )
*/

oGet:Copy()

//Prueba
IF nVal < 4
/*
cChars := Trim( GetFClipData( oGet:hWnd ) ) // Solo hay cuando tras seleccionar se da a "Copiar"
nCrLf := RAt( CRLF, cChars )
cChars := iif( Len( cChars ) == nCrLf + Len( CRLF ), ;
Stuff( cChars, nCrLf, 2, " " ), cChars )
If nVal > 3 .and. Empty( cTextForm ) .or. nVal < 4 .and. EmpTy( cChars )
MsgInfo( "Antes debe " + iif( nVal > 3, "seleccionar", "COPIAR" ) + " texto a cambiar.",

"Atención" )
Return Nil
Endif
*/
Do Case
Case nVal == 1
cChars := Letras( nVal, cChars,, .t. )

Case nVal == 2
cChars := Letras( nVal, cChars, , .t. )

Case nVal == 3
cChars := Letras( nVal, cChars, , .t. )
If lAcro
cChars := Acro( .t., cChars )
endif

Endcase

cChars := Trim( cChars )
nCrLf := RAt( CRLF, cChars )
cChars := iif( nCrLf > 0, Stuff( cChars, nCrLf, 2, "" ), cChars )

if oGet:lBlock
oGet:DelBlock()
endif

oGet:PutBlock( cChars )

oGet:HideCaret()

ELSE

//cChars := Trim( GTFToTxt( cTextForm ) )

Do Case
Case nVal == 4 // aqui no se usa esta llamada
cChars := Trim( Spanish( Upper( cChars ), .t. ) )
Case nVal == 5 // ni esta
cChars := Trim( Spanish( Lower( cChars ), .f. ) )
Case nVal == 6 // reiniciar si formateado
cChars := Letras( 3, cChars, .f., .t. )
//if lAcro
cChars := Acro( , cChars )
//endif
Endcase

if nVal < 6
nVal -= 3 // para lo siguiente
For nI = 1 To Len( cChars )
cTc := Substr( cChars, nI, 1 )

if cTc == "Á" .or. cTc == "É" .or. cTc == "Í" .or. cTc == "Ó" .or. ;
cTc == "Ú" .or. cTc == "Ü" .or. cTc == "Ñ" .or. cTc == "á" .or. cTc == "é" .or. ;
cTc == "í" .or. cTc == "ó" .or. cTc == "ú" .or. cTc == "ü" .or. cTc == "ñ"

cAct := Acentos( cTc, nVal, .f. )
cChars := Stuff( cChars, nI, Len( cAct[ 1 ] ), cAct[ 1 ] )
endif
Next

else
/*
// se pasa a texto sin formatos y font original
cChars := GTFToTxt( cTextForm )

cTextForm := TxtToGTF( cChars, , oFontx, nColorx ) // oGet:nAlign, oGet:GetCurFont(),

oGet:GetCurColor() )
//SetFClipData( oGet:hWnd, cChars, cTextForm, GTFToRTF( cTextForm ) )
//cChars := GetFClipData( oGet:hWnd )
//cChars := ( cTextForm ) // recupera el nuevo font y color basicos
*/
endif

//ENDIF

//oGet:BakUp()

if oGet:lBlock
oGet:DelBlock()
endif

oGet:PutBlock( cTextForm ) //cChars ) //cTextForm )
oGet:HideCaret()

ENDIF

if oGet:lStopVScroll()
oGet:UnDo()
else
oGet:DrawLines()
endif

oGet:ShowCaret()

oGet:VisibleCurLine()

oGet:lBak := .t. //f.

oGet:CheckState()

if oGet:bChange != nil
Eval( oGet:bChange, , , oGet )
endif

if oGet:bLocate != nil
Eval( oGet:bLocate, oGet:nLineRow, oGet:nLineCol )
endif
//SetFClipData( oGet:hWnd, "", "", "" ) //, cTextFormat, GTFToRTF( cTextFormat ) ) // vaciarlo ?
//oGet:Refresh()

// oGet:ReleaseDC() //HACE QUE NO SE PRODUZCA EL CAMBIO

return nil

// FIN TERCERA PARTE

// AHORA CUARTA PARTE

[Juan Planelles]

//AHORA CUARTA PARTE
Static Function Letras( nVal, cText, lInicio, lTrozo )
local n := 1, nLen, cChar := "", lVacio := .t.
local cPrev := "", min, may, cTc, nIni := 0, nSp := 0
local lSi := .t., aChar, cEl := "", cCadena := ""

DEFAULT lInicio := .t., lTrozo := .f.

if !lInicio // No es llamada automatica al inicio sino desde boton Mm
oGet:GetDC()
endif
memory( -1 )
DEFAULT cText := MemoRead( cFileDisc ) // está en Ansi !!!! NO OLVIDARLO
//cText := OemtoAnsi( StrTran( AnsiToOem( cText ), CRLF, " " ) ) Muy mal.
nLen := Len( cText )

Do Case

Case nVal == 1 // Pasar todo a Mayúsculas

For n = 1 to nLen
cTc := SubsTr( cText, n, 1 ) // Ansi
cChar := AnsiToOem( cTc ) //SubsTr( cText, n, 1 ) ) // Oem
if ( IsAlpha( cChar ) .and. IsLower( cChar ) ) .or. cChar == Chr( 164 )

if cChar == Chr( 164 ) // ñ
cText := Stuff( cText, n, 1, OemToAnsi(Chr( 165 )) ) // Ñ
else
cText := Stuff( cText, n, 1, OemToAnsi( Upper( cChar ) ) )
endif

else
if cTc == "Á" .or. cTc == "É" .or. cTc == "Í" .or. cTc == "Ó" .or. ;

// cTc = ANSIIIIII
cTc == "Ú" .or. cTc == "Ü" .or. cTc == "Ñ" .or. cTc == "á" .or. cTc == "é" .or. ;
cTc == "í" .or. cTc == "ó" .or. cTc == "ú" .or. cTc == "ü" .or. cTc == "ñ"
aChar := Acentos( cTc, 1, .f. )
lSi := aChar[ 2 ]
cText := Stuff( cText, n, Len( cTc ), Space( Len( cTc ) ) )


cTc := aChar[ 1 ]
cText := Stuff( cText, n, Len( cTc ), cTc ) // TODO ANSI
endif
endif
next

Case nVal == 2 // Pasar todo a Minúsculas

For n = 1 to nLen
cTc := SubsTr( cText, n, 1 )
cChar := AnsiToOem( cTc ) //SubsTr( cText, n, 1 ) )
if ( IsAlpha( cChar ) .and. IsUpper( cChar ) ) .or. cChar == Chr( 165 )
if cChar == Chr( 165 ) // Ñ
cText := Stuff( cText, n, 1, OemToAnsi(Chr( 164 )) ) // ñ
else
cText := Stuff( cText, n, 1, OemToAnsi( Lower( cChar ) ) )
endif
else // las vocales símbolos, acento y diéresis
if cTc == "Á" .or. cTc == "É" .or. cTc == "Í" .or. cTc == "Ó" .or. ; // estan en ANSIIIII
cTc == "Ú" .or. cTc == "Ü" .or. cTc == "Ñ" .or. cTc == "á" .or. cTc == "é" .or. ;
cTc == "í" .or. cTc == "ó" .or. cTc == "ú" .or. cTc == "ü" .or. cTc == "ñ"
aChar := Acentos( cTc, 2, .f. )
lSi := aChar[ 2 ]
cText := Stuff( cText, n, Len( cTc ), Space( Len( cTc ) ) )


cTc := aChar[ 1 ]
cText := Stuff( cText, n, Len( cTc ), cTc )
endif
endif
cTc := ""

next
if !lInicio // No es llamada automatica al inicio sino desde boton Mm
n := at( Lower( cTextFormat ), cText )
cText := Stuff( cText, n, 1, "" )
cText := Stuff( cText, n, Len( cTextFormat ), cTextFormat )
endif

Case nVal == 3 // Se pone en mins
lVacio := .f. ; lSi := .t. ; cPrev := "."
// Ahora buscar pos del primer caracter (no -> o digito) de la cadena de texto, p la sintaxis
// así no se tocan los códigos de formato

cCadena := iif( at( "GTF", cText ) > 0, GTFToTxt( cText ), cText )
nIni := at( LTrim(Substr(cCadena,1,10)), cText ) //at( LTrim(cCadena), cText )
//? ctext, ccadena, at( LTrim(Substr(cCadena,1,10)), cText )
cCadena := "" // liberar memoria
For n = 1 to nLen
cTc := SubsTr( cText, n, 1 ) // ANSIII
cChar := cTc //SubsTr( cText, n, 1 ) )
if IsAlpha( AnsiToOem(cChar) ) .or. IsDigit( AnsiToOem(cChar) ) .or. ;
cChar == ":" .or. cChar == "-" .or. cChar == Chr( 13 ) .or. cChar == CRLF .or. ;
cChar == "." .or. cChar == Chr( 165 ) .or. cChar == Chr( 164 )
//cChar := AnsiToOem( SubsTr( cText, n, 1 ) )
if IsAlpha( AnsiToOem(cChar) ) .or. IsDigit( AnsiToOem(cChar) ) .or. ;
cChar == ":" .or. cChar == "-" .or. cChar == Chr( 13 ) .or. cChar == CRLF .or. ;
cChar == "." .or. AnsiToOem(cChar) == Chr( 165 ) .or. AnsiToOem(cChar) == Chr( 164 )

cChar := AnsiToOem( cChar ) //SubsTr( cText, n, 1 ) ) // aquí ya a OEM::

if IsDigit( cChar )
// lSi := .f. // dejarlo quitado
endif
//if !lSi // no ponerlo, dejarlo quitado
cPrev := cChar
//endif
if cPrev == Chr( 13 ) .or. cPrev == CRLF .or. at( cPrev, ".-:" ) > 0
lSi := .t.
nSp := n
lSi := iif( cPrev == "." .and. SubsTr( cText, n+2, 1 ) == "." , .f., lSi ) // a.o. o.d. o.i. ...
else

if lSi .or. ( n == nIni ) .or. n == 1 .and. IsAlpha( cChar ) .and. !Empty( Trim (cChar) ) //.and. n >

nSp+1 .or. ( n == nIni ) //.or. n == nSp+1 .and. cChar == " "
if ( IsAlpha( cChar ) .and. IsLower( cChar ) ) .or. cChar == Chr( 164 ) .or. Isdigit( cChar )
if cChar == Chr( 164 ) // ñ
cText := Stuff( cText, n, 1, OemToAnsi(Chr( 165 )) ) // Ñ
else
cText := Stuff( cText, n, 1, OemToAnsi( Upper( cChar ) ) )
endif
//lSi := .f. // no ponerlo aqui
endif
if cChar != " " //!IsDigit( cChar ) // queda feo en la mayoria de usos
lSi := .f. // no quitarlo de aqui
nSp := 0
endif
else
if cChar == Chr( 165 ) // "Ñ" // Ñ
cText := Stuff( cText, n, 1, OemToAnsi(Chr( 164 )) ) // ñ
else
cText := Stuff( cText, n, 1, OemToAnsi( Lower( cChar ) ) )
endif
endif
endif
cPrev := cChar // no quitar
endif

else
if cTc == "Á" .or. cTc == "É" .or. cTc == "Í" .or. cTc == "Ó" .or. ;
cTc == "Ú" .or. cTc == "Ü" .or. cTc == "á" .or. cTc == "é" .or. ;
cTc == "í" .or. cTc == "ó" .or. cTc == "ú" .or. cTc == "ü" .or. cTc == "ñ" .or. cTc

== "Ñ"

aChar := Acentos( cTc, 3, lSi )
//if lTrozo
lSi := aChar[ 2 ]
//endif
//cText := Stuff( cText, n, Len( cTc ), Space( Len( cTc ) ) )


cTc := aChar[ 1 ]
cText := Stuff( cText, n, Len( cTc ), cTc )

endif
endif
cTc := ""

next

if !lInicio // No es llamada automatica al inicio sino desde boton Mm
n := at( Lower( cTextFormat ), cText )
cText := Stuff( cText, n, 1, "" )
cText := Stuff( cText, n, Len( cTextFormat ), cTextFormat )
endif
EndCase

if !lInicio // No es llamada automatica al inicio sino desde boton Mm
oGet:cText( cText )
oGet:Refresh()
endif
if !lTrozo
Memowrit( cFileDisc, cText )
endif
memory( -1 )
Return( cText )

Static function Acentos( cChar, n, lSi )

DEFAULT n := 3, lSi := .f.

if lSi
lSi := .f.
else
DO CASE
CASE n == 1
do Case
Case cCHar == "á"
cChar := "Á"
Case cChar == "é"
cChar := "É"
Case cChar == "í"
cChar := "Í"
Case cChar == "ó"
cChar := "Ó"
Case cChar == "ú"
cChar := "Ú"
Case cChar == "ü"
cChar := "Ü"
Case cChar == "ñ"
cChar := "Ñ"
EndCase

CASE n == 2 .or. n == 3
do Case
Case cCHar == "Ó"
cChar := "ó"
Case cChar == "É"
cChar := "é"
Case cChar == "Í"
cChar := "í"
Case cChar == "Á"
cChar := "á"
Case cChar == "Ú"
cChar := "ú"
Case cChar == "Ü"
cChar := "ü"
Case cChar == "Ñ"
cChar := "ñ"
EndCase

ENDCASE

endif

Return ( { cChar, lSi } )

static function Acro( lInicio, cTextEnv ) //
//Local oLine := oGet:oLine
Local cTexto := "", n3, cT2, lVacio //oGet:GetTextLine( oLine )
Local nLen := Len( cText ), n := 1, nI := 1, cChar := "", n1, n2, cTx := "", acT, nX, nHg, n5 := 0
local cMemo := "", ; //cFile := "ACRONIMS.DAT"
cT := "", lDelim := .t., nVez2 := 1, nP := 1, cT3 := ""
local aItems := {}, aIt := { "OJO DERECHO", "OJO IZQUIERDO", "DOS OJOS", "A.O.", "AO", ;
"O.D.", "OD ", "OD:", "O.I.", "OI ", "OI:", "L:", "C:", ;
"VOD", "VOI", "PIO ", "P.I.O.",

"PIO:", "D.R.", "DR.", "DR " },;
cX := AnsiToOem( " " )

DEFAULT lInicio := .t., cTextEnv := ""

if !lInicio // No es llamada automatica al inicio sino desde boton Mm
oGet:GetDC()
endif

// Se leen las palabras y acronimos mays, estan en Ansi
cMemo := MemoRead( cFAcro )
nI := MLCount( cMemo )
// Se lee el archivos de acronomos y textos, Ansi
For n = 1 to nI
aadd( aItems, AllTrim( memoLine( cMemo, , n ) ) )
Next

aItems := iif( Empty( aItems ), aIt, aItems )
nI := Len( aItems )

// DOCUMENTO A TRATAR
// se va a poner en mayusculas el nombre del paciente, cuantas veces lo hay en el texto
// Si no añado un espacio vacio al inicio no lee la primera palabra si es INFORME MÉDICO

cTexto := iif( EmpTy( cTextEnv ), MemoRead( cFileDisc ), cTextEnv ) // Se lee, en Ansi
//Primero Se pasa el documento a todo minúsculas, esta en Ansi
// Se pasa antes de la llamada
// los dos estan en Ansi y minusculas // AnsiToOem( MemoRead( cFileDisc ) )
// Si antes se ha llamado al modo sintaxis lo estará, en minusculas con sintaxis
cTx := cTexto
// cTx := iif( Len( LTrim( cTx ) ) == Len( cTx ), " " + cTx, cTx )
nLen := Len( cTx )

//cTx := AnsiToOem( cTx ) // se pone en Oem para las busquedas

For nVez2 = 1 To 2
// se pone el texto del documento en minusculas, las eñes y Oem
// estaba en Ansi
// primero el nombre del paciente
cT := mNombre
if nVez2 == 1
nP := 2
cT := Upper( Left( ( cT ), 1 ) )
acT := Acentos( ( cT ), 1 )
cT := ( acT[ 1 ] ) + ;
Trim( Spanish( Lower( SubsTr( ( mNombre ), 2 ) ) ) )
else // hay que buscarlo tambien todo en minus, que el el 1º de arriba en el mh1
nP := 1
cT := Trim( Spanish( Lower( ( mNombre ) ) ) )
endif
// ahora se revisa si lleva acentos o dieresis
For n = nP to Len( cT )
cChar := SubsTr( cT, n, 1 )
acT := Acentos( ( cChar ), 2 )
cChar := ( acT[ 1 ] )
cT := stuff( cT, n, Len( cChar ), cChar )
Next
// Pérez
// y ahora se busca en el documento en memoria el NOMBRE en minus sintaxis o total y se pasa a mays
// cTx en Oem y cTexto en Ansi

do while at( cT, cTx ) > 0
n1 := at( cT, cTx )
n2 := Len( cT )
cTx := Stuff( cTx, n1, n2, ( Trim( mNombre ) ) ) //aItems[ n ] )

enddo
// Fin procesamiento nombre
Next

For n = 1 to nI // cada acronimo o palabra

For nVez2 = 1 To 2 // busca en nvez2 = 2 inicial May + resto minusc

// hay que pasar a min incluso eñes y acentos con cada acronimo o texto

cT := aItems[ n ]

if nVez2 == 1
nP := 2
acT := Upper( Left( ( cT ), 1 ) )
acT := Acentos( ( acT ), 1 )
cT := ( acT[ 1 ] ) + ;
Trim( Spanish( Lower( SubsTr( ( cT ), 2 ) ) ) )
else // hay que buscarlo tambien todo en minus, que es el 1º de arriba en el mh1
nP := 1
cT := Spanish( Lower( ( cT ) ) )
endif

// ahora se revisa si lleva acentos o dieresis
For n1 = nP to Len( cT )
cChar := SubsTr( cT, n1, 1 )
acT := Acentos( ( cChar ), 2 )
cChar := ( acT[ 1 ] )
cT := stuff( cT, n1, 1, cChar )
Next

cT2 := cT
// revisado el acronimo en curso
if at( ("."), cT ) == 0 .and. at( (":"), cT ) == 0 .and. ;
at( (";"), cT ) == 0 .and. at( ( "-" ), cT ) == 0 ;


.and. at( ("hg"), cT ) == 0

lDelim := .f.

cT := AllTrim( cT )
acT := { cT + cX, cT + CRLF, cT + "." , cT + ";", cT + ":", cT + "(", cT + " = ", cT + "," , cT + " .-", ;
cT + "-", cT + " -", cT + " )", ;
iif( Len( cT ) > 10, cT, cT + cX ) }

For nX = 1 to Len( acT )
cT3 := cT := acT[nX]

Do While ValType( cT3 ) == "C" .and. at( cT3, cTx ) > 0
//? "HOLA", at( AnsiToOem(cT3), AnsiToOem(cTx ) )

n1 := at( AnsiToOem(cT3), AnsiToOem(cTx) )
if n1 == n5
exit
endif
n2 := Len( aItems[n] ) //cT3 )
n5 := n1

if at( "hg", cT ) > 0 // Hg tratamiento especial de esta palabra
nHg := at( "hg", cT )
cT :=SubsTr( cT, nHg, 2 )
cT := Stuff( cT, nHg, 2, "Hg" )
cTx := Stuff( cTx, n1, n2, cT ) // se introduce en el texto en

memoria

else
// ahora se pasa a mays
cTx := Stuff( cTx, n1, n2, aItems[ n ] )

endif

EndDo

Next

else

Do While at( cT, cTx ) > 0
n1 := at( cT, cTx )
n2 := Len( aItems[n] ) //Len( cT )
if n1 == n5
exit
endif
n5 := n1
cChar := SubsTr( cTx, n1, n2 )
If cT == "hg"
cTx := Stuff( cTx, n1, n2, "Hg" ) //aItems[ n ] )
cTexto := Stuff( cTexto, n1, n2, "Hg" ) //aItems[ n ] )
else
cTx := Stuff( cTx, n1, n2, aItems[ n ] )

endif
EndDo
endif
if nVez2 == 1
cT := cT2
endif
Next

Next

//Memowrit( cFileDisc, OemToAnsi( cTx ) ) //exto ) )

cTexto := ( cTx ) //MemoRead( cFileDisc )

if !lInicio // No es llamada autcomatica al inicio sino desde boton Mm
oGet:cText( cTexto )
oGet:Refresh()
endif

return( cTexto )

//----------------------------------------------------------------------------//

function AddResource( nHResource, cType )

AAdd( aResources, { cType, nHResource, ProcName( 3 ), ProcLine( 3 ) } )

return nil

//----------------------------------------------------------------------------//

function DelResource( nHResource )

local nAt

if ( nAt := AScan( aResources, { | aRes | aRes[ 2 ] == nHResource } ) ) != 0
ADel( aResources, nAt )
ASize( aResources, Len( aResources ) - 1 )
endif

return nil


function PalBmpFree( h )
return DeleteObject( h )


static function Ribbon()

? "Hola"

return nil

Procedure ChangeSelect( aObj )

local n

aObj[ 1 ]:lSelected := .t.
for n = 2 to len( aObj )
aObj[ n ]:lSelected := .f.
aObj[ n ]:Refresh()
next
return

Function ChangeBmp( oBmp )

static lWork

if lWork == nil
lWork := .f.
endif

if !lWork
lWork := .t.
nIndex+=nAvance

if nIndex > LEN( aBmp )
nAvance := -1
nIndex := LEN( aBmp ) + nAvance
elseif nIndex == 0
nAvance := 1
nIndex := 1 + nAvance
endif
oBmp:hBitmap = aBmp[ nIndex ]
oBmp:Refresh()
lWork := .f.

endif


return nil

Static Function Fuentes( uVal ) //Bold, lItalic, lUnderline, lStrikeOut, nAncho )
local oFont, nFont, oFont2, nMargend //, cTextForm, nCrLf, lFocus, cChars
local nLenFonts := Len( oGet:aFonts )
local aFonts := Array( nLenFonts ), cTextForm, nCrLf, lFocus, cChars
local n, nMargen := 4, nCols, nFilas, nFactor := 0.70, nFilaIni := 2, lUser := .t., aJustif := {}
local cText, cMemo := MemoRead( CFGAYUDA ), nWEdit := Eval({|| oGet:nWidth })
local lFile32 := ( File( 'Prev32.Dll' ) .or. ;
File( AllTrim( GetSysDir() ) + '\Prev32.Dll' ) )

nFactor := Val( AllTrim( memoLine( cMemo, , 4 ) ) )
nFactor := 1

oGet:GetDC()
if oGet:lBlock
cTextForm := oGet:GetBlock()
nCrLf := At( CRLF, cTextForm )
lFocus := oGet:lFocusBlock
cChars:= cTextForm // es lo mismo y no tengo que cambiar el texto
else
MsgWait( "No hay Texto seleccionado", "Atención", 0.8 )
Return Nil
endif

oGet:Copy()

nColor := oGet:GetCurColor() //INLINE ::nColor

oFont := oGet:GetCurFont() //INLINE hFont := oGet:hFont, ;
//oGet:aFonts[ AScan( oGet:aFonts, { |oFont| oFont:hFont == hFont } ) ]
/* oFont2 := TFont():New( iif( Empty( oFont:cFaceName ), "Arial", oFont:cFaceName ), ;


oFont:nWidth, oFont:nHeight, ,;
oFont:lBold, , , , oFont:lItalic, oFont:lUnderline,;
oFont:lStrikeOut, , , , )
*/
//? oFont2:cFacename, oFont2:lBold, oFont2:lItalic, oFont2:lUnderline, oFont2:lStrikeOut, oFont2:nHeight
Do Case

Case uVal == 1
oFont2:lBold := !(oFont2:lBold)

Case uVal == 2
oFont2:lItalic := !(oFont2:lItalic)

Case uVal == 3
oFont2:lUnderLine := !(oFont2:lUnderLine)

Case uVal == 4
oFont2:lStrikeOut := !(oFont2:lStrikeOut)

Case uVal == 5
(oFont2:nHeight)++

Case uVal == 6
(oFont2:nHeight)--

ENDCASE
//? oFont2:cFacename, oFont2:lBold, oFont2:lItalic, oFont2:lUnderline, oFont2:lStrikeOut, oFont2:nHeight

AAdd( oGet:aFonts, oFont2 )

oGet:SetFormat( oFont2, nColor )

SysRefresh()

oGet:FormatBlock( oFont2, nColor )

if oGet:lBlock
oGet:DelBlock()
endif

oGet:PutBlock( cChars )

oGet:HideCaret()

if oGet:lStopVScroll()
oGet:UnDo()
else
oGet:DrawLines()
endif

oGet:ShowCaret()

oGet:VisibleCurLine()
oGet:VisibleBlock( .t. ) //lVisible )
oGet:lBak := .t. //f.

oGet:CheckState()

if oGet:bChange != nil
Eval( oGet:bChange, , , oGet )
endif

if oGet:bLocate != nil
Eval( oGet:bLocate, oGet:nLineRow, oGet:nLineCol )
endif

oGet:Refresh()

return Nil //oGet:aFonts
//FIN DE LA CUARTA PARTE

// SI HAY ALGUN FALLO MEJOR ENVIARLO COMO FICHERO DE TEXTO POR E-MAIL.

//SALUDOS: - JUAN -

[Antonio Linares]

Juan,

Por favor envíame los ficheros por email a alinares@fivetechsoft.com con un fichero adjunto ZIP renombrado con extensión ZOP para que gmail no lo pare, gracias