Problema ao copilar programa

[AVInfo Sistemas]

eis a classe WBROWSE

// Modificaciones y Agregados a la TWBrowse version FW2.1

// ======================================================

// 1) Nueva varialble ::bLogicPos. Sirve para el Scroll Vertical en DBf. Si

// devuelve nil, se usa el calculo por defecto. Si devuelve un valor

// numerico especifica la posicion relativa respecto al total de registros.

// 2) Todos los movimientos del oVScroll, se controlan con ::bLogicPos si

// estuviera definida.

// 3) Para DBFs se define por defecto a ::bLogicLen y a ::bLogicPos, al

// tratarse de Drivers DBFCDX de Clip53, COMIX y DBFCDXAX de ADS Advantage

// DataBase Server.

// 4) Nuevas variables ::lAdjLastCol y ::lAdjBrowse. La primera contiene un

// valor logico que indica si se quiere estirar la ultima columna al

// tama¤o del control. Por defecto es .T., es lo que hace FW originalmente.

// La segunda variable indica si se quiere ajustar el browse hasta el final

// del control, osea, cuando se ha seleccionado la modalidad ultima columna

// no ajustada, es decir, ::lAdjLastCol:= .F., si asume .T. se pintar  una

// una columna ficticia vac¡a.

// ....y recordar que sobre gustos, no hay nada escrito !!!!

// 5) BUG Arrglado en los metodos ::GoRight() y ::GoLeft(). Cuando no

// exist¡an elementos en el browse, y siendo lCellStyle:= .t., mostraba

// una celda seleccionada si se presionaban las teclas de movimiento. Ha sido

// solucionado.

// 6) Nueva varaible ::aHJustify. Funciona igual que ::aJustify, es decir, un

// array cuyos elementos asumen valores, que idicaran a la clase la

// justificacion de la columna para Cabeceras (Headers). En caso de no

// definirse, o enviarse menor cantidad de elementos, se toma por defecto

// los valores de ::aJustify. Valores que puede asumir cada elemento del

// Array, (tambien aplicable a ::aJustify) :

// a) .F. o 0 -> Indica justificado a la derecha

// .T. o 1 -> Indica justificado a la izquierda

// c) 2 -> Indica justificado al centro.

// 7) Nueva variable ::lDrawHeaders, permite manejar la visualizacion de las

// cabeceras. Por defecto es .T., un valor .F. indicar  la no visualizacion.

// 8) BUG Arreglado en metodo ::LButtonDown(). Si con el Mouse se accedia a

// una celda visualizada parcialmente, estando en modalidad lCellStyle:= .t.,

// TWbrowse no se reacomodaba, para su visualizacion completa. Fue corregido.

// 9) BUG Arreglado en metodo ::IsColVisible(). Fue reescrita y simplificada.

// Eventuales errores se producian en ambientes MDI por errores en el codigo.

//10) Nuevas variables ::bTextColor y ::bBkColor. Son bloques de codigo que

// se eval£an en tiempo de pintado. Pueden devolver una valor NUMERICO,

// que representa el color RGB con el cual se pintar  el texto o fondo,

// segun el bloque. Si devuelve otro valor, los colores ser n los especi-

// ficados en las respectivas varialbes de instancia de la clase.

// Se env¡an 3 argumentos: {|nRow,nCol,nStyleLine| ... }

// nStyleLine, puede asumir los siguientes valores:

// 0 -> Celda standard normal

// 1 -> Celda Header

// 2 -> Celda Footer

// 3 -> Celda standard normal seleccionada

// Ver Pto. 41)

//11) Nueva variable ::nClrLine. Especifica un color especifico para las lineas

// separadoras de celdas. Por defecto se utilizan los colores de linea

// especificos, segun el valor de ::nLineSyle. (Jose Gimenez)

//12) Nuevos Metodos ::DrawHeaders( nColPressed ) y ::DrawFooters( nColPressed ).

// Estos metodos son usados internamente por la clase para el pintado de

// cabeceras y pies del grid. Puede recibir como parametro el numero de

// columna, la cual quiere que se pinte con efecto PUSH, osea presionada.

//13) Nuevas Variables:

// ::lDrawFooters -> Especifica si se quiere pintar los Footers o no.

// Por defecto es .F.

// ::aFooters -> Array o Bloque de Codigo que devuelva un Array, de

// cadenas o numeros (Bmp), que se pintaran el el borde

// inferior del browse.

// ::aFJustify -> Cumple la misma funcion que aJustify, pero para Footers.

// En caso de no especificarse se toman por defecto, los

// valores de aJustify.

// ::nClrFFore y ::nClrFBack -> Color RGB de texto y fondo respectiva-

// mente de los (Pies) Footers. Son analogas a las

// variables ::nClrForeHead y ::nClrBackHead, usadas en

// las Cabeceras (Headers).

//14) BUG Arreglado en metodo ::LDblClick(). No se procesaba el bloque

// ::bDblClick definido por el usuario.

//15) Nuevos metodos ::GetColHeader() y ::GetColFooter(). A ellos deben

// pasarse los siguientes par metros ( nMRow, nMCol ), es decir,

// coordenadas de Mouse nRow y nCol. Si me retorta valor > 0 indica que

// se presiono sobre el Header o Footer, representando ese valor la columan

// en la que se hizo el click. Es util para procesar dentro de ::bLDblClick y

// ::bLCkicked.

// Analogamente, si se quiere saber la posicion de celda, en la cual se

// ha presionado el Mouse, puede usarse el metodo ::nWRow( nMRow ).

//16) Nuevo metodo ::bGoLogicPos. Bloque que se ejecuta cuando se quiere ir a

// un registro especifico de la tabla. Por defecto se define para RDD

// DBFCDX de Clip53, COMIX y DBFCDXAX de ADS Advantage DataBase Server.

//17) Nuevas variables ::nClrNFFore y ::nClrNFBack. NF (no focus). Indican

// el color RGB de Texto y Fondo respectivamente de la(s) Celda(s)

// seleccionada(s) cuando NO HAY FOCO sobre el control. Ambas son analogas

// a las variables ::nClrForeFocus y ::nClrBackFocus.

// Resumiendo Color(es) de Celda(s) Seleccionada(s):

// +-------------------------+--------------+-----------------+

// | Color celda seleccionada| CON FOCO | SIN FOCO |

// +-------------------------+--------------+-----------------+

// | Colores de Texto (Fore) | ::nClrNFFore | ::nClrForeFocus |

// | Colores de Fondo (Back) | ::nClrNFBack | ::nClrBackFocus |

// +-------------------------+--------------+-----------------+

//18) Modificacion al metodo ::GoRight(), en caso de que no exista Barra Scroll

// Horizontal y no exita modalidad ::lCellStyle:= .F., y, ademas, las

// columnas sean perfectamente visualizadas en el area del control, no se

// corr¡a hacia la derecha. Arreglado.

//19) Modificacion de Colores: Se arreglaron algunos colores por defecto, que

// se tomen los definidos en Windows.

//20) Se corrigio el metodo para determinar el ancho de los Scrolles verticales

// Se usa para ello el GetSysMetrics( SM_CXSCROLL ) y no mas 16 fijo.

//21) Nuevas variables "DE CLASE": ::lVScroll y ::lHScroll. Las mismas fijan

// si debe o no crearse los scrolles respectivos cuando se genera el

// control "desde codigo". Por defecto simpre se crean. PERO OJO: Se crearon

// de clase, porque no era posible crearlas de otra forma, debido a que

// el encargado de definir el nStyle es el contructor New(). Para no

// modificar los comandos xBase, se opto por esta solucion. Por eso deben

// setearse ANTES de definir el control.

// Ejemplo: TWBrowse():lHScroll:= .f.

// @y,x LISTBOX ......

// Pero OJO, el valor .F. no queda para todos los controles que sean creados

// posteriori, sino, la clase se encarg  de volver a .T. a ::lHScroll.

//22) Los metodos ::DrawHeader() y ::DrawFooters() soportan como argumento el

// Nro.de columna que queremos que apresca presionada.

// Ver Pto.12)

//23) Nueva variable ::nFreeze. Indica el numero de columnas que deber n

// congelarse a la izquierda. Funciona igual que la variable de instancia

// TBrowse:Freeze de CA-Clipper. Por defecto asume 0. Para ello han sido

// redefinidos TOTALMENTE y optimizados los metodos ::GoRight() y

// ::GoLeft(), y ademas se modific¢ ::HScroll() tambien. ::lButtonUp() y

// ::lButtonDown(), y ::VertLine() devuelve la columna que se ha modificado.

//24) Nuevo metodo GoToCol( ). Este desplaza a una determinada columna

// y hace el ajuste del browse que corresponda.

//25) Adios y Chau al parpadeo.... La funcion WBrwPane() se encarga de pintar

// las zonas excedetes, es decir, no cobiertas por las celdas, con el color

// de fondo del control, por supuesto. Se evita el borrado del control, en

// el metodo ::Refresh().

//26) Los metodos ::lEditCol y ::EditCol, editan con el color de fondo que

// tenga la celda en curso, aun cuando tenga color de columna personalizado.

//27) Se modifico el metodo ::Edit() y se agrego la funcion __Edit(),

// para evitar el parpadeo, cuando pasamos de celda en celda, debido a la

// modalidad MODAL que tienen los dialogos. Para ello se crea un dialogo

// oculto y se evita es parpadeo antiest‚tico.

//28) El metodo ::Refresh() ha sido redefinido, y estabiliza automaticamente

// despues de un ABM, ademas refresca automaticamente los Footers en caso

// de que hay sido definido como Bloque de Codigo.

//---15/11/2000---

//29) Se incorpor¢ el metodo ::SetPage() en los objetos Scroll, para ver

// proporcionales los ThumbPos de los mismos. NOTA: La clase Scroll tiene

// este metodo, pero por razones desconocidas esta comentado. Debe borrarse

// el comentario e incorporar la clase Scroll.c modificada por Jose Gimenez.

//30) En bloques ::bLogicPos y ::bLogicLen se incorporo la posibilidad de que

// NO haya un alias, osea asignarlo como "", para que no se desplace el

// browse durante un proceso determinado.

//31) Se modifico ::LostFocus() y ::GotFocus(). En ambientes MDI, en las

// clausulas VALID, generalmente, se usan para cerrar las bases de datos

// asociadas al MDICHILD. Ocurria que el metodo ::LostFocus() y en ocasiones

// ::GotFocus(), se ejecutaban POSTERIORMENTE al VALID del la MDI, lo cual,

// estando las bases ya cerradas, y llamandose en consecuencia a DrawSelect()

// osea, hacian uso del (::cAlias)->, se produc¡a un RunTimeError, dado

// que el alias no exitia.

// Se soluciono agregando una funcion EmtpyAlias() que verfica si el area

// de trabajo esta activa. Ya no sera necesesario, incorporar en los VALIDs

// de las MDI, cosas como oLbx:Destroy() o "artilugios" similares !!!!

//32) Nueva variable ::bEdit, que es un bloque de codigo que se ejecuta por

// cada edicion de columna. Este bloque permite que el usuario con poco

// esfuerzo, (ya que del rastreo y movimiento de columnas se encarga

// ::Edit() ), cree su propia edicion, es decir, llame de forma

// PERSONALIZADA a ::lEdit() o a un GET creado por el mismo, evite edicion

// de determinadas columnas, etc, etc. En pocas palabras, sirve para

// personalizar la edicion por celdas. El bloque recibe argumentos:

// nCol (Columna a editar)

// cBuffer (Buffer de Campo)

// lFirstEdit (Valor logico que indica si es la primera columna que

// se edita en el bucle de rastreo)

// El usuario, deber  entonces asignar el valor de edicion a la base de datos

// o al Array, dado que no es mas automatico al definirse un ::bEdit.

// La asignacion automatica de buffer trae muchos problemas; cuando el orden

// de las columnas no coincide con el orden Fisico de la base de datos, o,

// cuando la columna tiene una concatenacion o resultado compuesto distinto al

// dato real alojado en la base de datos, o tambien cuando se editan campos

// en un Browse de Array.

// El bloque DEBE DEVOLVER un valor Logico, que indicara al bucle del metodo

// ::Edit(), si se quiere o no finalizar el mismo.

//---15/05/2001---

//33) Nueva variable ::lDrawSelect, que especifica si el usuario quiere

// mostrar o no la celda o linea seleccionada.(Dedicado a mi amigo Giancarlo)

// Por defecto es verdadero.

//34) Nueva variable ::lOnlyBorder, que especifica si el usuario quiere

// mostrar solamente el borde de la celda o fila seleccionada, respetandose

// entonces los colores de fondo o los bloques de color en su caso. Por

// defecto es .F.. No se aplica a nLineStyle==3 (3D).

//35) Nueva variable ::lDrawFocusRect, por defecto es .T., y especifica si

// se quiere el borde punteado cuando hay foco. No aplicable nLineStyle==3.

//36) Los BitMaps ya no se estiran, se centran en la celda, o se ajustan, en

// caso que su tama¤o sea superior a la celda.

//37) Las coordenadas de EditCell ya se ajustaron, para que no se exceda el

// area de celda.

//38) Las Lineas, Footers y Headers, soportan MULTILINE, que esta dado por

// la separacion CRLF de la cadena respectiva. Se ajusta a centrado vertical,

// salvo que su alto supere el alto de celda, entoces, se ajustar  al borde

// superior de celda.

//39) Nuevas variables ::nHeaderHeight, nFooterHeight, ::nLineHeight, que

// especifican el alto en pixels de Headers, Footers y Linea Standard del

// browse. Ya no depende la altura de la fuente. Por defecto las tres

// asumen el valor de la fuente, por compatibilidad.

//40) Nueva variable: ::bFont. Es un bloque de codigo opcional, que se ejecuta

// en tiempo de pintado, y envia 3 argumentos: {|nRow,nCol,nStyleLine| ... }

// nStyleLine, puede asumir los siguientes valores:

// 0 -> Celda standard normal

// 1 -> Celda Header

// 2 -> Celda Footer

// 3 -> Celda standard normal seleccionada

// Este bloque puede devolver un valor NUMERICO, que representa el handle o

// manejador de una fuente de Windows (HFONT). Cualquier otro valor que no

// sea numerico ser  rechazado, y se asumir  que debe usarse la fuente del

// control standard. Como vemos esto trae una altisima flexibilidad en cuanto

// a las fuentes del grid, la cual si quisieramos, cada celda podr¡a asumir

// fuentes de distinto tipo, tama¤o y estilo.

//41) !!!PRECAUCION!!!: Modificaciones a los argumentos de las variables y la

// ejecucion de ::bTextColor y ::bBkColor. Al igual que la variable ::bFont,

// se agrega tambien ademas de nRow, nCol, un tercer argumento "nStyleLine".

// Pero AHORA ESTE BLOQUE TAMBIEN SE EJECUTA CUANDO SE PINTEN HEADERS,

// FOOTERS Y CELDA(S) SELECCIONADAS. Es por eso que hay que tener mucho

// cuidado (MAS LO QUE YA LOS USABAN), dado que antes solo se ejecutaba

// el bloque para lineas stardard del grid, y ahora para TODO TIPO DE LINEA.

// Es por eso que utilizando el argumento nLineStyle se puede controlar la

// TOTALIDAD de los colores del grid en tiempo de ejecucion, aportando alta

// flexibilidad.

//42) Nuevo metodo ::Set3DStyle(). Su sola ejecucion indicar  que el Grid se

// pinte como en las viejas epocas de FW, osea los colores y el formato 3D

// que ten¡a en versiones 1.8 o inferiores.

//---27/06/2001---Revision 10.-

//43) Nueva variable de instancia ::lSelect. Determina si estamos parados en

// la fila seleccionada.

//44) Nueva navegacion por celdas. El bloque lEditCol puede devolver los sig.

// nuevos valores numericos tambien:

// 1 Contiunar en Proxima Celda

// 2 Contiunar en Proxima Fila (desde 1ra col)

// 3 Contiunar en Proxima Fila (desde la misma col)

// -1 Contiunar en Anterior Celda

// -2 Contiunar en Anterior Fila (desde 1ra.Col)

// -3 Contiunar en Anterior Fila (desde la misma col)

// Recordemos que ::nLastKey es actualizado por este metodo para tener la

// ultima tecla presionada.

//45) Nueva variable de instancia ::bSeek, ::cBuffer, ::nBuffer, ::bUpdateBuffer

// y el Metodo DbfSeek().

// Sirven para automamtizar busqueda incremental. Ello implica que

// si esta definido el bloque ::bSeek, al presionar las teclas de caracteres

// o borrado, la variable ::cBuffer asumira valores, y luego se ejecutara el

// code block ::bSeek.

// Para bases de datos esta automatizado, con solo usar DbfSeek(),

// o sea: oLbx:bSeek:= {|| oLbx:DbfSeek( .T. ) }. Este metodo "puede" tener

// 4 argumentos:

// 1ro-> Si la busqueda es Soft (default lo es)

// 2do-> Un codeblock que identifique un error cuando se produsca eof().

// 3ro-> Tama¤o del Buffer al momento de la busqueda. Por defecto asume

// el real.

// 4to-> Si al momento de la busqueda se quiere que lo haga en mayusculas

// (default lo es).

// Si el bloque ::bSeek devuelve .T. indicara al sistema que debera hacer el

// refresh respectivo, caso contrario, le podemos retornar .F. y estabilizar

// de la manera que se nos ocurra el Grid.-

// Cuando se ejecuta el codeblock ::bSeek se activa una nueva variable de

// instancia llamada ::lWorking, que sirve como bandera para evitar agota-

// mientos del stack. El que considere que no es necesario esto, puede poner

// el flag a .F., osea, oLbx:bSeek:= {|| oLbx:lWorking:= .F., .... }

// El CodeBlock ::bUpdateBuffer se ejecuta cada vez que se produzca alguna

// modificacion el la variable de instancia ::cBuffer.

// La variable de instancia ::nBuffer determina el tama¤o maximo de caracteres

// que puede asumir el ::cBuffer.

//46) Nuevos codeblocks ::bGoRight, ::bGoLeft, cuyo resultado deben devolver

// una variable logica. Un valor false inhabilita ir hacia la derecha/izquirda

//---03/07/2001---Revision 11.-

// Se han corregido algunos bugs que se presentaban en la busqueda incremental

//47) Nueva Justificacion. Los valores que pueden asumir los elementos de

// ::aJustify, ::aHJustify y ::aFJustify, pueden identificar adicionalmente,

// la justificacion vertical, ademas de la clasica justificacion horizontal,

// usando la funcion nOr() ( similar a | en lenguaje C )

// A estos efectos se han definido las constantes respectivas:

//

// Para Justificacion Horizontal

// #define HA_LEFT 0 (Default)

// #define HA_RIGHT 1

// #define HA_CENTER 2

//

// Para Justificacion Horizontal

// #define VA_TOP 4

// #define VA_BOTTOM 8

// #define VA_CENTER 32 (Default)

//---21/09/2001---Revision 12.-

// Se han corregido algunos bugs que se presentaban en la busqueda incremental

//48) Nuevo Metodo SetTXT(). Este metodo permite mostrar un archivo de texto

// automaticamente dentro del area del browse. Es muy facil de usar:

// oLbx:SetTXT( [ ] )

// Puede ser:

// Character -> Es el nombre del archivo a mostrar. La classe en este

// caso crea automaticamente un objeto TTxtFile que se

// autodestruira al finalizar el ListBox en forma automa-

// tica. No debe preocuparse.

// Objeto TTxtFile -> Un objeto creado previamente por el usuario. En

// este caso la classe NO destruye el objeto que

// fue creado por el usuario.

// Si no se especifica parametros, se pedira que seleccion el archivo

// de texto a mostrar, mediate el Common Dialog de Windows.

// 49) Nuevas variables de Instancia relacionadas con ::SetTXT()

//

// ::oTXT........... Objeto TTXTFile creado automaticamente, cuando se

// especifica el nombre de archivo en el metodo SetTXT

// Este objeto sera destruido automaticamente.

//

// Estas 3 son de uso interno, y sirven para controlar el desplazamiento

// horizontal del browse de datos.

//

// ::nTXTFrom....... Valor que sirve para recortar la cadena de muestra

// ::nTXTSkip....... Valor que incrementa/decrementa la ::nTXTFrom cada

// vez que se quiera ir hacia la derecha o izquierda

// respectivamente.

// ::nTXTMaxSkip.... Valor tope, que identifica el maximo que puede

// asumir lar variable ::nTXTSkip

//

//---26/10/2001---Revision 13.-

// 50) Se corrigio un BUG en el metodo KeyDown(). Gracias Ing.Mario Gonzalez

//

//---12/12/2001---Revision 14.-

// 51) Se incorporo ::nColFPressed y ::nColHPressed, si se quiere mantener o

// mostrar como presionada, una celda de las cabeceras o los pies.

//

//---11/05/2002---Revision 15.-

// 52) Compatible con FW para Harbour :-) MUCHAS gracias a mi amigo Jose Gimenez

// 53) Soporte automatico para ADS Local para Harbour

// 54) Nuevos Metodos: nWCol( nMCol )

// IsOverHeader( nMRow, nMCol )

// IsOverFooter( nMRow, nMCol )

// 55) Nuevas Variables de Instancia: nHeaderStyle

// (Similares a nLineStyle) nFooterStyle

//

#xtranslate VSCROLL_WIDTH => ;

If( ::oVScroll != Nil .and. Eval(::bLogicLen) > 1, 18, 0 )

#xtranslate _POSVSCROLL_ =>;

( Eval( ::bLogicPos ) - 1 ) / Max( 1, ::nLen - 1 ) * 100

#xtranslate _JHEADERS_ =>;

If( ::aHJustify != Nil, ::aHJustify, ::aJustify )

#xtranslate _JFOOTERS_ =>;

If( ::aFJustify != Nil, ::aFJustify, ::aJustify )

#xtranslate _WBRWSET_ =>;

WBrwSet( ::lAdjLastCol, ::lAdjBrowse,;

::lDrawHeaders, ::lDrawFooters,;

::nHeaderHeight, ::nFooterHeight,;

::nLineHeight )

#define _DLL_CH

#define _FOLDER_CH

#define _ODBC_CH

#define _DDE_CH

#define _VIDEO_CH

#define _TREE_CH

#include "FiveWin.ch"

#include "WinApi.ch"

#include "InKey.ch"

#include "Set.ch"

#include "Constant.ch"

#include "Report.ch"

#define HA_LEFT 0 // by CeSoTech Alineaciones Horizontales y Verticales

#define HA_RIGHT 1

#define HA_CENTER 2

#define VA_TOP 4

#define VA_BOTTOM 8

#define VA_CENTER 32

#ifdef __CLIPPER__

#define EM_SETSEL (WM_USER+1)

#else

#define EM_SETSEL 177

#endif

#define GW_HWNDFIRST 0

#define GW_HWNDLAST 1

#define GW_HWNDNEXT 2

#define GWL_STYLE -16

#define HWND_BROADCAST 65535 // 0xFFFF

#define CS_DBLCLKS 8

#define COLOR_ACTIVECAPTION 2

#define COLOR_WINDOW 5

#define COLOR_CAPTIONTEXT 9

#define COLOR_HIGHLIGHT 13

#define COLOR_HIGHLIGHTTEXT 14

#define COLOR_BTNFACE 15

#define COLOR_BTNTEXT 18

#define COLOR_WINDOWTEXT 8 // by CeSoTech

#define COLOR_BTNSHADOW 16 // by CeSoTech

#define ES_CENTER 1 // by CeSoTech

#define WM_SETFONT 48 // 0x30

// Lines Styles

#define LINES_NONE 0

#define LINES_BLACK 1

#define LINES_GRAY 2

#define LINES_3D 3

#define LINES_DOTED 4

#ifdef __XPP__

#define Super ::TControl

#define New _New

#xtranslate _DbSkipper => DbSkipper

#endif

#ifdef __HARBOUR__

#xtranslate _DbSkipper => DbSkipper

#endif

extern DBSKIP

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

CLASS TWBrowse FROM TControl

DATA cAlias, cField, uValue1, uValue2

DATA bLine, bSkip, bGoTop, bGoBottom, bLogicLen, bChange, bAdd

DATA nRowPos, nColPos, nLen, nAt, nColAct

// nColPos -> 1ra. Columna que se muestra en pantalla

// nColAct -> Columna Activa

DATA nMaxFilter // Maximum number of records to count

// on indexed filters

DATA lHitTop, lHitBottom, lCaptured, lMChange

DATA lAutoEdit, lAutoSkip

DATA lCellStyle AS LOGICAL INIT .f.

DATA aHeaders, aColSizes

DATA nClrBackHead, nClrForeHead

DATA nClrBackFocus, nClrForeFocus

DATA aJustify, aActions

DATA oGet

DATA nLineStyle

DATA lIconView, aIcons, bIconDraw, bIconText

DATA nIconPos

DATA bLogicPos // CeSoTech

DATA bGoLogicPos // CeSoTech

DATA lAdjLastCol INIT .t. // CeSoTech

DATA lAdjBrowse INIT .f. // CeSoTech

DATA lDrawHeaders INIT .t. // CeSoTech

DATA aHJustify // CeSoTech

DATA bTextColor, bBkColor // CeSoTech

DATA nClrLine // CeSoTech

DATA aFooters // CeSoTech

DATA lDrawFooters INIT .f. // CeSoTech

DATA aFJustify // CeSoTech

DATA nClrFBack, nClrFFore // CeSoTech de Footers

DATA nClrNFBack, nClrNFFore // CeSoTech de Celda Seleccionada

// cuando no esta lFocused.

CLASSDATA lVScroll // CeSoTech

CLASSDATA lHScroll // CeSoTech

DATA nFreeze INIT 0 // CeSoTech

DATA aTmpColSizes // CeSoTech

DATA bEdit // CeSoTech

DATA lDrawSelect INIT .t. // CeSoTech

DATA lOnlyBorder INIT .f. // CeSoTech

DATA lDrawFocusRect INIT .t. // CeSoTech

DATA nHeaderHeight INIT -1 // CeSoTech ->Alto Header

DATA nFooterHeight INIT -1 // CeSoTech ->Alto Footer

DATA nLineHeight INIT -1 // CeSoTech ->Alto linea Browse

DATA bFont // CeSoTech ->Bloque q'dev.Handle Font

DATA lSelect INIT .f. // CeSoTech

DATA lWorking INIT .F. // CeSoTech Evita posibles desbordamientos

DATA cBuffer INIT "" // CeSoTech Ideas de Jose Maria Torres

DATA nBuffer INIT 50 // CeSoTech

DATA bSeek // CeSoTech

DATA bUpdateBuffer // CeSoTech

DATA bGoLeft INIT {|| .T. } // CeSoTech

DATA bGoRight INIT {|| .T. } // CeSoTech

DATA oTXT // Objetos TXT construidos por TWBrowse

DATA nTXTFrom INIT 1 // CeSoTech

DATA nTXTSkip INIT 4 // CeSoTech

DATA nTXTMaxSkip INIT 49 // CeSoTech

DATA nColFPressed // CeSoTech

DATA nColHPressed // CeSoTech

DATA nHeaderStyle INIT 3 // CeSoTech

DATA nFooterStyle INIT 3 // CeSoTech

CLASSDATA lRegistered AS LOGICAL

METHOD New( nRow, nCol, nWidth, nHeigth, bLine, aHeaders, ;

aColSizes, oWnd, cField, uVal1, uVal2, bChange,;

bLDblClick, bRClick, oFont, oCursor, nClrFore,;

nForeBack, cMsg, lUpdate, cAlias, lPixel, bWhen,;

lDesign, bValid, bLClick, aActions ) CONSTRUCTOR

METHOD ReDefine( nId, bLine, oDlg, aHeaders, aColSizes, cField, uVal1,;

uVal2, bChange, bLDblClick, bRClick, oFont,;

oCursor, nClrFore, nClrBack, cMsg, lUpdate,;

cAlias, bWhen, bValid, bLClick, aActions ) CONSTRUCTOR

METHOD nAtCol( nCol ) INLINE ::nWCol( nCol )

METHOD nAtIcon( nRow, nCol )

METHOD lCloseArea() INLINE ;

If( ! Empty( ::cAlias ), ( ::cAlias )->( DbCloseArea() ),),;

If( ! Empty( ::cAlias ), ::cAlias := "",), .t.

METHOD LDblClick( nRow, nCol, nKeyFlags )

METHOD Default()

METHOD BugUp() INLINE ::UpStable()

METHOD Display()

METHOD DrawIcons()

METHOD DrawLine( nRow ) INLINE ;

_WBRWSET_,; // CeSoTech

wBrwLine( ::hWnd, ::hDC, If( nRow == nil, ::nRowPos, nRow ), ;

Eval( ::bLine ), ::GetColSizes(), ::nColPos,;

::nClrText, ::nClrPane,;

If( ::oFont != nil, ::oFont:hFont, 0 ),;

ValType( ::aColSizes ) == "B", ::aJustify, nil, ::nLineStyle,;

0, .f., ::bTextColor, ::bBkColor, ::nClrLine,,,::bFont )

METHOD DrawSelect()

METHOD lEditCol( nCol, uVar, cPicture, bValid, nClrFore, nClrBack,;

aItems, bAction )

METHOD Edit( nCol, lModal )

METHOD EditCol( nCol, uVar, cPicture, bValid, nClrFore, nClrBack,;

aItems, bAction )

METHOD GetColSizes() INLINE ;

If( ValType( ::aColSizes ) == "A", ::aColSizes, Eval( ::aColSizes ) )

METHOD GetDlgCode( nLastKey )

METHOD GoUp()

METHOD GoDown()

METHOD GoLeft()

METHOD GoRight()

METHOD GoTop()

METHOD GoBottom()

METHOD GotFocus() INLINE Super:GotFocus(),;

If( ::nLen > 0 .and. ! EmptyAlias( ::cAlias ) .and. ;

! ::lIconView, ::DrawSelect(),)

METHOD HScroll( nWParam, nLParam )

MESSAGE DrawIcon METHOD _DrawIcon( nIcon, lFocused )

METHOD Initiate( hDlg ) INLINE Super:Initiate( hDlg ), ::Default()

METHOD IsColVisible( nCol )

METHOD KeyDown( nKey, nFlags )

METHOD KeyChar( nKey, nFlags )

METHOD LButtonDown( nRow, nCol, nKeyFlags )

METHOD LButtonUp( nRow, nCol, nKeyFlags )

METHOD LostFocus( hCtlFocus ) INLINE Super:LostFocus( hCtlFocus ),;

If( ::nLen > 0 .and. ! EmptyAlias( ::cAlias ) .and. ;

! ::lIconView, ::DrawSelect(),)

METHOD MouseMove( nRow, nCol, nKeyFlags )

METHOD PageUp( nLines )

METHOD PageDown( nLines )

METHOD Paint()

METHOD RecAdd() INLINE If( ::bAdd != nil, Eval( ::bAdd ),)

MESSAGE RecCount METHOD _RecCount( uSeekValue )

METHOD Report( cTitle, lPreview )

METHOD ReSize( nSizeType, nWidth, nHeight )

METHOD nRowCount()

METHOD SetArray( aArray )

METHOD SetCols( aData, aHeaders, aColSizes )

METHOD SetFilter( cField, uVal1, uVal2 )

METHOD SetTree( oTree )

METHOD ShowSizes()

METHOD Skip( n )

METHOD UpStable()

METHOD VertLine( nColPos, nColInit )

METHOD VScroll( nWParam, nLParam )

METHOD DrawHeaders( nColPressed ) // CeSoTech

METHOD DrawFooters( nColPressed ) // CeSoTech

METHOD GetColHeader( nMRow, nMCol ) // CeSoTech

METHOD GetColFooter( nMRow, nMCol ) // CeSoTech

METHOD GoToCol( nCol ) // CeSoTech

METHOD Refresh( lSysRefresh ) // CeSoTech

METHOD nWRow( nMRow ) // CeSoTech

METHOD nWCol( nMCol ) // CeSoTech

METHOD Set3DStyle() // CeSoTech -> Estilo del viejo FW

METHOD aBrwPosRect()

METHOD DbfSeek( lSoftSeek, bEof ) // CeSoTech

METHOD SetTXT( uTxt ) // CeSoTech

METHOD Destroy() INLINE If( ::oTXT !=Nil, (::oTXT:End(), ::oTXT:= Nil),),;

Super:Destroy()

METHOD IsOverHeader( nMRow, nMCol )

METHOD IsOverFooter( nMRow, nMCol )

ENDCLASS

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

METHOD nRowCount() CLASS TWBrowse

If ! "TCBROWSE" $ ::ClassName

return wBrwRows( ::hWnd, 0, If( ::oFont != nil, ::oFont:hFont, 0 ) ) // CeSoTech

EndIf

// Por defecto para evitar conflictos con TCBrowse

return nWRows( ::hWnd, 0, If( ::oFont != nil, ::oFont:hFont, 0 ) ) - 1

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

METHOD New( nRow, nCol, nWidth, nHeigth, bLine, aHeaders, aColSizes, oWnd,;

cField, uVal1, uVal2, bChange, bLDblClick, bRClick,;

oFont, oCursor, nClrFore, nClrBack, cMsg, lUpdate, cAlias,;

lPixel, bWhen, lDesign, bValid, bLClick, aActions ) CLASS TWBrowse

#ifdef __XPP__

#undef New

#endif

DEFAULT nRow := 0, nCol := 0, nHeigth := 100, nWidth := 100,;

oWnd := GetWndDefault(),;

nClrFore := GetSysColor( COLOR_WINDOWTEXT ),; // CeSoTech CLR_BLACK,;

nClrBack := GetSysColor( COLOR_WINDOW ),;

lUpdate := .f., cAlias := Alias(), lPixel := .f.,;

lDesign := .f.

#ifdef __XPP__

DEFAULT cAlias := ""

#endif

::cCaption = ""

::nTop = nRow * If( lPixel, 1, BRSE_CHARPIX_H ) // 14

::nLeft = nCol * If( lPixel, 1, BRSE_CHARPIX_W ) //8

::nBottom = ::nTop + nHeigth - 1

::nRight = ::nLeft + nWidth - 1

::oWnd = oWnd

::lHitTop = .f.

::lHitBottom = .f.

::lFocused = .f.

::lCaptured = .f.

::lMChange = .t.

::nRowPos = 1

::nColPos = 1

::nColAct = 1

::nStyle = nOr( WS_CHILD, ; //CeSoTech /// WS_VSCROLL, WS_HSCROLL,;

WS_BORDER, WS_VISIBLE, WS_TABSTOP,;

If( lDesign, WS_CLIPSIBLINGS, 0 ) )

::nId = ::GetNewId()

::cAlias = cAlias

::bLine = bLine

::lAutoEdit = .f.

::lAutoSkip = .f.

::lIconView = .f.

::lCellStyle = .f.

::nIconPos = 0

::SetFilter( cField, uVal1, uVal2 )

::bAdd = { || ( ::cAlias )->( DbAppend() ), ::UpStable() }

::aHeaders = aHeaders

::aColSizes = aColSizes

::nLen = 0

::lDrag = lDesign

::lCaptured = .f.

::lMChange = .t.

::bChange = bChange

::bLClicked = bLClick

::bLDblClick = bLDblClick

::bRClicked = bRClick

::oCursor = oCursor

::oFont = oFont

//::nLineStyle := LINES_3D

::nLineStyle := LINES_GRAY

::nLineStyle:= 10 // by CeSoTech

/// CeSoTech ///

If (::lVScroll== Nil .or. (::lVScroll!=Nil .and. ::lVScroll))

::nStyle:= nOr( ::nStyle, WS_VSCROLL )

EndIf

If (::lHScroll== Nil .or. (::lHScroll!=Nil .and. ::lHScroll))

::nStyle:= nOr( ::nStyle, WS_HSCROLL )

EndIf

/// CeSoTech ///

::nClrBackHead := GetSysColor( COLOR_BTNFACE )

::nClrForeHead := GetSysColor( COLOR_BTNTEXT )

::nClrBackFocus := GetSysColor( COLOR_HIGHLIGHT )

::nClrForeFocus := GetSysColor( COLOR_HIGHLIGHTTEXT) // CeSoTech CLR_WHITE

::nClrFBack := ::nClrBackHead // by CeSoTech

::nClrFFore := ::nClrForeHead // by CeSoTech

::nClrNFBack := GetSysColor( COLOR_HIGHLIGHT ) // COLOR_BTNSHADOW ) // by CeSoTech

::nClrNFFore := ::nClrForeFocus // by CeSoTech

::cMsg = cMsg

::lUpdate = lUpdate

::bWhen = bWhen

::bValid = bValid

::aActions = aActions

::SetColor( nClrFore, nClrBack )

#ifdef __XPP__

DEFAULT ::lRegistered := .f.

#endif

::Register( nOr( CS_VREDRAW, CS_HREDRAW, CS_DBLCLKS ) )

if ! Empty( oWnd:hWnd )

::Create()

::Default()

::lVisible = .t.

oWnd:AddControl( Self )

else

oWnd:DefControl( Self )

::lVisible = .f.

endif

if lDesign

::CheckDots()

endif

return Self

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

METHOD ReDefine( nId, bLine, oDlg, aHeaders, aColSizes, cField, uVal1, uVal2,;

bChange, bLDblClick, bRClick, oFont, oCursor,;

nClrFore, nClrBack, cMsg, lUpdate, cAlias,;

bWhen, bValid, bLClick, aActions ) CLASS TWBrowse

DEFAULT oDlg := GetWndDefault(),;

nClrFore := GetSysColor( COLOR_WINDOWTEXT ),; // CeSoTech CLR_BLACK,;

nClrBack := GetSysColor( COLOR_WINDOW ), lUpdate := .f., cAlias := Alias()

::lHitTop = .f.

::lHitBottom = .f.

::lFocused = .f.

::nId = nId

::nRowPos = 1

::nColPos = 1

::nColAct = 1

::cAlias = cAlias

::oWnd = oDlg

::aHeaders = aHeaders

::aColSizes = aColSizes

::nClrPane = CLR_LIGHTGRAY

::nClrText = CLR_WHITE

::nLen = 0

::lDrag = .f.

::lCaptured = .f.

::lVisible = .f.

::lCaptured = .f.

::lMChange = .t.

::bLine = bLine

::bChange = bChange

::bLClicked = bLClick

::bLDblClick = bLDblClick

::bRClicked = bRClick

::oCursor = oCursor

::oFont = oFont

::nLineStyle := LINES_GRAY

//::nLineStyle := LINES_3D

::nLineStyle:= 10 // by CeSoTech

::nClrBackHead := GetSysColor( COLOR_BTNFACE )

::nClrForeHead := GetSysColor( COLOR_BTNTEXT ) // CeSoTech CLR_BLACK

::nClrBackFocus := GetSysColor( COLOR_HIGHLIGHT )

::nClrForeFocus := GetSysColor( COLOR_HIGHLIGHTTEXT ) // CeSoTech CLR_WHITE

::nClrFBack := ::nClrBackHead // by CeSoTech

::nClrFFore := ::nClrForeHead // by CeSoTech

::nClrNFBack := GetSysColor( COLOR_HIGHLIGHT ) // COLOR_BTNSHADOW ) // by CeSoTech

::nClrNFFore := ::nClrForeFocus // by CeSoTech

::cMsg = cMsg

::lUpdate = lUpdate

::bWhen = bWhen

::bValid = bValid

::aActions = aActions

::lAutoEdit = .f.

::lAutoSkip = .f.

::lIconView = .f.

::lCellStyle = .f.

::nIconPos = 0

::SetColor( nClrFore, nClrBack )

::SetFilter( cField, uVal1, uVal2 )

::bAdd = { || ( ::cAlias )->( DbAppend() ), ::UpStable() }

::Register( nOr( CS_VREDRAW, CS_HREDRAW, CS_DBLCLKS ) )

oDlg:DefControl( Self )

return Self

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

METHOD DrawSelect() CLASS TWBrowse

LOCAL nTextColor, nBkColor

_WBRWSET_ /*CeSoTech*/

If ::nLen < 1

return Nil

EndIf

::lSelect:= .T.

If ! ::lDrawSelect // Si no quiere mostrar celda(s) activa !!!

::DrawLine()

::lSelect:= .F.

return Nil

EndIf

If ::lOnlyBorder

nTextColor:= ::nClrText

nBkColor := ::nClrPane

Else

nTextColor:= If( ::lFocused, ::nClrForeFocus, ::nClrNFFore )

nBkColor := If( ::lFocused, ::nClrBackFocus, ::nClrNFBack )

EndIf

if ::lCellStyle

::DrawLine()

WBrwLine( ::hWnd, ::hDC, ::nRowPos, Eval( ::bLine ),;

::GetColSizes(), ::nColPos,;

nTextColor, nBkColor,;

If( ::oFont != nil, ::oFont:hFont, 0 ),;

ValType( ::aColSizes ) == "B", ::aJustify,, ::nLineStyle,;

::nColAct, ::lFocused, ::bTextColor, ::bBkColor, ::nClrLine,;

.f., .T., ::bFont, ::lDrawFocusRect )

else

WBrwLine( ::hWnd, ::hDC, ::nRowPos, Eval( ::bLine ),;

::GetColSizes(), ::nColPos,;

nTextColor, nBkColor,;

If( ::oFont != nil, ::oFont:hFont, 0 ),;

ValType( ::aColSizes ) == "B", ::aJustify,, ::nLineStyle, ;

.f., ::lFocused, ::bTextColor, ::bBkColor, ::nClrLine,;

.f., .T., ::bFont, ::lDrawFocusRect )

endif

::lSelect:= .F.

return nil

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

METHOD DrawIcons() CLASS TWBrowse

local nWidth := ::nWidth(), nHeight := ::nHeight()

local nRow := 10, nCol := 10

local n := 1, nIcons := Int( nWidth / 50 ) * Int( nHeight / 50 )

local hIcon := ExtractIcon( "user.exe", 0 )

local oFont, cText

DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0, -8 UNDERLINE

SelectObject( ::hDC, oFont:hFont )

SetBkColor( ::hDC, CLR_BLUE )

SetTextColor( ::hDC, CLR_WHITE )

while n <= nIcons .and. ! ( ::cAlias )->( EoF() )

if ::bIconDraw != nil .and. ::aIcons != nil

hIcon = ::aIcons[ Eval( ::bIconDraw, Self ) ]

endif

DrawIcon( ::hDC, nRow, nCol, hIcon )

if ::bIconText != nil

cText = cValToChar( Eval( ::bIconText, Self ) )

else

cText = Str( ( ::cAlias )->( RecNo() ) )

endif

DrawText( ::hDC, cText, { nRow + 35, nCol - 5, nRow + 48, nCol + 40 },;

1 )

nCol += 50

if nCol >= nWidth - 32

nRow += 50

nCol = 10

endif

( ::cAlias )->( DbSkip() )

n++

end

( ::cAlias )->( DbSkip( 1 - n ) )

oFont:End()

return nil

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

METHOD ReSize( nSizeType, nWidth, nHeight ) CLASS TWBrowse

::nRowPos = Min( ::nRowPos, Max( ::nRowCount(), 1 ) )

return Super:ReSize( nSizeType, nWidth, nHeight )

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

METHOD SetArray( aArray ) CLASS TWBrowse

::nAt = 1

::cAlias = "ARRAY"

// ::bLine = { || { aArray[ ::nAt ] } }

::bLogicLen = { || ::nLen := Len( aArray ) }

::bLogicPos := Nil // CeSoTech

::bGoLogicPos:= Nil // CeSoTech

::bGoTop = { || ::nAt := 1 }

::bGoBottom = { || ::nAt := Eval( ::bLogicLen ) }

::bSkip = { | nSkip, nOld | nOld := ::nAt, ::nAt += nSkip,;

::nAt := Min( Max( ::nAt, 1 ), Eval( ::bLogicLen ) ),;

::nAt - nOld }

return nil

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

METHOD SetTree( oTree ) CLASS TWBrowse

local oItem := oTree:oFirst

::lMChange = .f.

::bLine = { || oItem:GetLabel() }

::aColSizes = { || oItem:ColSizes() }

::bGoTop = { || oItem := oTree:oFirst }

::bGoBottom = { || oItem := oTree:GetLast() }

::bSkip = { | n | oItem := oItem:Skip( @n ), ::Cargo := oItem, n }

::bLogicLen = { || ::nLen := oTree:nCount() }

::bLogicPos := Nil // CeSoTech

::bGoLogicPos := Nil // CeSoTech

::lDrawHeaders:= .f. // CeSoTech

::bLDblClick = { || If( oItem:oTree != nil,;

( oItem:Toggle(), ::Refresh() ),) }

::Cargo = oItem

::bKeyChar = { | nKey | If( nKey == 13 .and. oItem:oTree != nil,;

( oItem:Toggle(), ::Refresh() ),) }

if ::oHScroll != nil

::oHScroll:SetRange( 0, 0 )

::oHScroll = nil

endif

oTree:Draw()

return nil

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

METHOD Paint() CLASS TWBrowse

local n := 1, nSkipped := 1, nLines

local nSkip, nRealSkip

if ::lIconView

::DrawIcons()

return 0

endif

if ::nRowPos == 1 .and. ! Empty( ::cAlias ) .and. ;

Upper( ::cAlias ) != "ARRAY" .and. Upper( ::cAlias ) != "_TXT_"

if ! ( ::cAlias )->( EoF() )

( ::cAlias )->( DbSkip( -1 ) )

if ! ( ::cAlias )->( BoF() )

( ::cAlias )->( DbSkip() )

endif

endif

endif

::DrawHeaders() // CeSoTech

::DrawFooters() // CeSoTech

if ( ::nLen := Eval( ::bLogicLen ) ) > 0

////////////////////////////////////

// AutoEstabilizacion by CeSoTech //

////////////////////////////////////

nSkip := 1 - ::nRowPos

nRealSkip:= ::Skip( nSkip )

if nSkip <> nRealSkip

::nRowPos-= nRealSkip - nSkip

::nRowPos:= Max( ::nRowPos, 1 )

EndIf

#ifdef __XPP__

nLines = ::nRowCount()

while n <= nLines .and. nSkipped == 1

::DrawLine( n )

nSkipped = ::Skip( 1 )

if nSkipped == 1

n++

endif

end

::Skip( ::nRowPos - n )

#else

// WBrwPane() returns the nº of visible rows

// WBrwPane recieves at aColSizes the Array or a Block

// to get dinamically the Sizes !!!

::Skip( ::nRowPos - wBrwPane( ::hWnd, ::hDC, Self, ::bLine,;

::aColSizes, ::nColPos, ::nClrText, ::nClrPane,;

If( ::oFont != nil, ::oFont:hFont, 0 ), ::aJustify, ;

::nLineStyle, 0 , .f., ::bTextColor, ::bBkColor, ::nClrLine,;

::oBrush:nRGBColor, ::bFont ) )

#endif

if ::nLen < ::nRowPos

::nRowPos = ::nLen

endif

::DrawSelect()

endif

If ::oVScroll != Nil .and. ::bLogicPos != Nil // by CeSoTech

::oVScroll:SetPos( _POSVSCROLL_ )

EndIf

if ! Empty( ::cAlias ) .and. Upper( ::cAlias ) != "ARRAY" ;

.and. Upper( ::cAlias ) != "_TXT_"

::lHitTop = ( ::cAlias )->( BoF() )

::lHitBottom = ( ::cAlias )->( EoF() )

endif

return 0

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

METHOD GoUp() CLASS TWBrowse

local nSkipped

local nLines := ::nRowCount()

if ( ::nLen := Eval( ::bLogicLen ) ) < 1

return nil

endif

if ! ::lHitTop

::DrawLine()

if ::Skip( -1 ) == -1

::lHitBottom = .f.

if ::nRowPos > 1

::nRowPos--

else

WBrwScrl( ::hWnd, -1, If( ::oFont != nil, ::oFont:hFont, 0 ), ::nLineStyle )

endif

else

::lHitTop = .t.

endif

::DrawSelect()

if ::oVScroll != nil

If ::bLogicPos != Nil // By CeSoTech

::oVScroll:SetPos( _POSVSCROLL_ )

Else

::oVScroll:GoUp()

EndIf

endif

if ::bChange != nil

Eval( ::bChange, Self )

endif

endif

return nil

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

METHOD GoDown() CLASS TWBrowse

local nSkipped

local nLines := ::nRowCount()

if ( ::nLen := Eval( ::bLogicLen ) ) < 1

return nil

endif

if ! ::lHitBottom

::DrawLine()

if ::Skip( 1 ) == 1

::lHitTop = .f.

if ::nRowPos < nLines

::nRowPos++

else

WBrwScrl( ::hWnd, 1, If( ::oFont != nil, ::oFont:hFont, 0 ), ::nLineStyle )

endif

else

::lHitBottom = .t.

endif

::DrawSelect()

if ::oVScroll != nil

If ::bLogicPos != Nil // By CeSoTech

::oVScroll:SetPos( _POSVSCROLL_ )

Else

::oVScroll:GoDown()

EndIf

endif

if ::bChange != nil

Eval( ::bChange, Self )

endif

endif

return nil

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

METHOD GoLeft() CLASS TWBrowse // by CeSoTech

LOCAL aSizes:= ::GetColSizes()

LOCAL nCols := Len( aSizes )

LOCAL lColVisible, nColAct, lRefreshAll:= .t.

LOCAL lGoLeft:= Eval( ::bGoLeft )

If ::cAlias == "_TXT_"

If lGoLeft .and. ::nTXTFrom > 1

::nTXTFrom-= ::nTXTSkip

return .T.

Else

MsgBeep()

return .F.

EndIf

EndIf

If !( ::nColAct > 1 ) .or. ! lGoLeft

return .f.

Else

If ::aTmpColSizes == Nil

::aTmpColSizes:= AClone( aSizes ) // Guardo Long. Originales

EndIf

If ::nFreeze > 0

::nFreeze:= Max( Min( ::nFreeze, nCols - 1 ), 1 )

::nColPos:= 1

If !::lCellStyle

::nColAct--

aSizes[::nColAct]:= ::aTmpColSizes[::nColAct]

If ::nColAct <= ::nFreeze + 1

::nColAct:= 1

EndIf

If( ::nLen > 0, ::Refresh(), )

Else

::nColAct--

lColVisible:= !( aSizes[::nColAct] == 0 )

aSizes[::nColAct]:= ::aTmpColSizes[::nColAct]

If !lColVisible

If( ::nLen > 0, ::Refresh(), )

Else

lRefreshAll:= .f.

If( ::nLen > 0, ::DrawSelect(), )

EndIf

EndIf

Else // No tiene Columnas Freeze

If !::lCellStyle

::nColAct--

::nColPos--

If( ::nLen > 0, ::Refresh(), )

Else

::nColAct--

lColVisible:= .t.

While .t.

If ! ::IsColVisible( ::nColAct ) .and. ::nColAct < ::nColPos

lColVisible:= .f.

::nColPos--

Loop

Else

Exit

EndIf

EndDo

If !lColVisible

If( ::nLen > 0, ::Refresh(), )

Else

lRefreshAll:= .f.

If( ::nLen > 0, ::DrawSelect(), )

EndIf

EndIf

EndIf

If ::oHScroll != Nil

::oHScroll:SetPos( ::nColAct )

EndIf

EndIf

return lRefreshAll

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

METHOD GoRight() CLASS TWBrowse // by CeSoTech

LOCAL aSizes:= ::GetColSizes()

LOCAL nCols := Len( aSizes )

LOCAL lColVisible, nColAct, lRefreshAll:= .t.

LOCAL lGoRight:= Eval( ::bGoRight )

If ::cAlias == "_TXT_"

If lGoRight .and. ::nTXTFrom <= ::nTXTMaxSkip

::nTXTFrom+= ::nTXTSkip

return .T.

Else

MsgBeep()

return .F.

EndIf

EndIf

If !( ::nColAct < nCols ) .or. ! lGoRight

return .f.

Else

If ::aTmpColSizes == Nil

::aTmpColSizes:= AClone( aSizes ) // Guardo Long. Originales

EndIf

////////////// Hagamos un simple razonamiento :-) que la cabeza no solo

////////////// es para pinarnos :-)

If !::lCellStyle .and. ::IsColVisible( nCols ) .and. ::oHScroll == Nil

// Si no hay edicion por

return .f. // celdas y cabe todo en

EndIf // el control no es necesario

////////////// // ir hacia la derecha !!!:-)

If ::nFreeze > 0

::nFreeze:= Max( Min( ::nFreeze, nCols - 1 ), 1 )

::nColPos:= 1

If !::lCellStyle

::nColAct:= Max( ::nColAct, ::nFreeze + 1 )

If ::nColAct < nCols

aSizes[::nColAct]:= 0

::nColAct++

If( ::nLen > 0, ::Refresh(), )

EndIf

Else

lColVisible:= .t.

::nColAct++

nColAct:= ::nFreeze + 1 // Rellena con Size 0 a su izquierda

While .t. // desde la 1ra.no congelada

If ! ::IsColVisible( ::nColAct ) .and. nColAct < ::nColAct

lColVisible:= .f.

aSizes[nColAct]:= 0

nColAct++

Loop

Else

Exit

EndIf

EndDo

If !lColVisible

If( ::nLen > 0, ::Refresh(), )

Else

lRefreshAll:= .f.

If( ::nLen > 0, ::DrawSelect(), )

EndIf

EndIf

Else // No tiene Columnas Freeze

If !::lCellStyle

::nColAct++

::nColPos++

If( ::nLen > 0, ::Refresh(), )

Else

::nColAct++

lColVisible:= .t.

While .t.

If ! ::IsColVisible( ::nColAct ) .and. ::nColAct > ::nColPos

lColVisible:= .f.

::nColPos++

Loop

Else

Exit

EndIf

EndDo

If !lColVisible

If( ::nLen > 0, ::Refresh(), )

Else

lRefreshAll:= .f.

If( ::nLen > 0, ::DrawSelect(), )

EndIf

EndIf

EndIf

If ::oHScroll != Nil

::oHScroll:SetPos( ::nColAct )

EndIf

EndIf

return lRefreshAll

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

METHOD GoTop() CLASS TWBrowse

if ( ::nLen := Eval( ::bLogicLen ) ) < 1

return nil

endif

if ! ::lHitTop

Eval( ::bGoTop )

::nRowPos = 1

::Refresh()

::lHitTop = .t.

::lHitBottom = .f.

if ::oVScroll != nil

If ::bLogicPos != Nil // By CeSoTech

::oVScroll:SetPos( _POSVSCROLL_ )

Else

::oVScroll:GoTop()

EndIf

endif

if ::bChange != nil

Eval( ::bChange, Self )

endif

endif

return nil

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

METHOD GoBottom() CLASS TWBrowse

local nSkipped

local nLines // := ::nRowCount()

local n

_WBRWSET_ // by CeSoTech

nLines := ::nRowCount() // " "

if ( ::nLen := Eval( ::bLogicLen ) ) < 1

return nil

endif

if ! ::lHitBottom

::lHitBottom = .t.

::lHitTop = .f.

Eval( ::bGoBottom )

nSkipped = ::Skip( -( nLines - 1 ) )

::nRowPos = 1 - nSkipped

::GetDC()

for n = 1 to -nSkipped

::DrawLine( n )

::Skip( 1 )

next

::DrawSelect()

::ReleaseDC()

if ::oVScroll != nil

::nLen = Eval( ::bLogicLen )

If ::bLogicPos != Nil // By CeSoTech

::oVScroll:SetPos( _POSVSCROLL_ )

Else

if ::oVScroll:nMax != ::nLen

::oVScroll:SetRange( 1, ::nLen )

endif

::oVScroll:GoBottom()

EndIf

endif

if ::bChange != nil

Eval( ::bChange, Self )

endif

endif

return nil

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

METHOD LDblClick( nRow, nCol, nKeyFlags ) CLASS TWBrowse

local nClickRow := ::nWRow( nRow )

local nBrwCol

if nClickRow == ::nRowPos .and. ::nLen > 0

nBrwCol = ::nAtCol( nCol )

if ::lAutoEdit

::Edit( nBrwCol )

else

return Super:LDblClick( nRow, nCol, nKeyFlags )

endif

else // CeSoTech

return Super:LDblClick( nRow, nCol, nKeyFlags ) // CeSoTech

endif

return nil

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

METHOD LButtonDown( nRow, nCol, nKeyFlags ) CLASS TWBrowse

local nColAct // by CeSoTech

local nClickRow, nSkipped

local nColPos := 0, nColInit := ::nColPos - 1

local oRect, nAtCol

if ::lDrag

return Super:LButtonDown( nRow, nCol, nKeyFlags )

endif

nClickRow = ::nWRow( nRow )

if ::nLen < 1 .and. nClickRow != 0

return nil

endif

if ::lMChange .and. ;

(::IsOverHeader( nRow, nCol ) .or. ::IsOverFooter( nRow, nCol )) .and.;

AScan( ::GetColSizes(),;

{ | nColumn | nColPos += nColumn,;

nColInit++,;

nCol >= nColPos - 1 .and. ;

nCol <= nColPos + 1 }, ::nColPos ) != 0

if ! ::lCaptured

::lCaptured = .t.

::Capture()

::VertLine( nColPos, nColInit )

endif

return nil

endif

::SetFocus()

if ::IsOverHeader(nRow,nCol) .and. Valtype(nKeyFlags) == "N" .and. ::nWCol(nCol) > 0

if ::aActions != nil .and. ;

( nAtCol := ::nAtCol( nCol ) ) <= Len( ::aActions )

if ::aActions[ nAtCol ] != nil

::DrawHeaders() // CeSoTech

::DrawFooters() // CeSoTech

::ReleaseDC()

Eval( ::aActions[ nAtCol ], Self, nRow, nCol )

::DrawHeaders() // CeSoTech

::DrawFooters() // CeSoTech

::ReleaseDC()

else

MsgBeep()

endif

else

MsgBeep()

endif

endif

if nClickRow > 0 .and. nClickRow != ::nRowPos .and. ;

nClickRow < ::nRowCount() + 1 .and. ::nWCol(nCol) > 0

::DrawLine()

nSkipped = ::Skip( nClickRow - ::nRowPos )

::nRowPos += nSkipped

if ::oVScroll != nil

If ::bLogicPos != Nil // By CeSoTech

::oVScroll:SetPos( _POSVSCROLL_ )

Else

::oVScroll:SetPos( ::oVScroll:GetPos() + nSkipped )

EndIf

endif

if ::lCellStyle

If ( nAtCol:= ::nAtCol( nCol ) ) > 0

::GoToCol( nAtCol )

EndIf

endif

::DrawSelect()

::lHitTop = .f.

::lHitBottom = .f.

if ::bChange != nil

Eval( ::bChange, Self )

endif

else

if ::lCellStyle

If ( nAtCol:= ::nAtCol( nCol ) ) > 0

::GoToCol( nAtCol )

EndIf

endif

endif

Super:LButtonDown( nRow, nCol, nKeyFlags )

return 0

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

METHOD LButtonUp( nRow, nColM, nFlags ) CLASS TWBrowse

LOCAL aSizes, nColChange // CeSoTech

if ::lDrag

return Super:LButtonUp( nRow, nColM, nFlags )

endif

if ::lCaptured

::lCaptured = .f.

ReleaseCapture()

nColChange:= ::VertLine() // Asignacion by CeSoTech

// CeSoTech -> Si cambio el ancho de columna, y estoy en nFreeze > 0

// deber‚ redimensionar el items de la matriz temporaria real de

// dimensiones !!!.

If ::nFreeze > 0

aSizes:= ::GetColSizes()

If ::aTmpColSizes == Nil

::aTmpColSizes:= AClone( aSizes )

Else

::aTmpColSizes[nColChange]:= aSizes[nColChange]

EndIf

EndIf

// CeSoTech //

endif

Super:LButtonUp( nRow, nColM, nFlags )

return nil

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

METHOD Default() CLASS TWBrowse

local n, aFields

local cAlias := Alias()

local nElements, nTotal := 0

local nDefaultHeight

if ::oFont == nil

::oFont = ::oWnd:oFont

endif

nDefaultHeight:= WBrwHeight( ::hWnd,;

If( ::oFont != nil, ::oFont:hFont, 0 ) )

If ::nHeaderHeight <= 0

::nHeaderHeight:= nDefaultHeight

EndIf

If ::nFooterHeight <= 0

::nFooterHeight:= nDefaultHeight

EndIf

If ::nLineHeight <= 0

::nLineHeight:= nDefaultHeight

EndIf

DEFAULT ::aHeaders := {}, ::aColSizes := {}

if ::bLine == nil

if Empty( ::cAlias )

::cAlias = cAlias

else

cAlias = ::cAlias

endif

::bLine = { || _aFields( Self ) }

if ::aJustify == nil

::aJustify = Array( nElements := Len( Eval( ::bLine ) ) )

for n = 1 to nElements

::aJustify[ n ] = ( ValType( ( cAlias )->( FieldGet( n ) ) ) == "N" )

next

endif

endif

DEFAULT nElements := Len( Eval( ::bLine ) )

if Len( ::aHeaders ) < nElements // == nil

if ::Cargo == nil

::aHeaders = Array( nElements )

for n = 1 to nElements

::aHeaders[ n ] = ( cAlias )->( FieldName( n ) )

next

else

::aHeaders = { "" }

endif

endif

if Len( ::GetColSizes() ) < nElements

::aColSizes = Afill(Array( nElements ), 0 )

aFields = Eval( ::bLine )

for n = 1 to nElements

::aColSizes[ n ] := If( ValType( aFields[ n ] ) != "C",;

15,; // Bitmap handle

GetTextWidth( 0, Replicate( "B", ;

Max( Len( ::aHeaders[ n ] ), ;

Len( aFields[ n ] ) ) + 1 ),;

If( ! Empty( ::oFont ), ::oFont:hFont,) ) )

next

endif

if lAnd( GetWindowLong( ::hWnd, GWL_STYLE ), WS_VSCROLL ) .or. ;

GetClassName( ::hWnd ) == "ListBox"

::nLen := Eval( ::bLogicLen )

If ::bLogicPos == Nil // CeSoTech

DEFINE SCROLLBAR ::oVScroll VERTICAL OF Self ;

RANGE Min(1, ::nLen), ::nLen

Else

DEFINE SCROLLBAR ::oVScroll VERTICAL OF Self RANGE 1, If(::nLen==0,0,100)

EndIf

::oVScroll:SetPage( Min( ::nRowCount(), ::nLen - 1 ) )

endif

if lAnd( GetWindowLong( ::hWnd, GWL_STYLE ), WS_HSCROLL )

if ::Cargo == nil // it is not a tree

DEFINE SCROLLBAR ::oHScroll HORIZONTAL OF Self ;

RANGE 1, Len( ::GetColSizes() )

AEval( ::GetColSizes(), { | nSize | nTotal += nSize } )

::oHScroll:SetPage( 1, Len( ::GetColSizes() ) )

endif

endif

if ::uValue1 != nil

Eval( ::bGoTop )

endif

if ::bChange != nil

Eval( ::bChange, Self )

endif

// CeSoTech -> Actualizo las variables de la Clase a Nil, para que siempre

// por defecto haya Scrolles, salvo que el usuario antes de

// algun constructor diga lo contrario.

::lVScroll:= Nil

::lHScroll:= Nil

return nil

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

METHOD KeyDown( nKey, nFlags ) CLASS TWBrowse

local lRefresh

do case

case nKey == VK_UP

::cBuffer:= ""

::GoUp()

case nKey == VK_DOWN

::cBuffer:= ""

::GoDown()

case nKey == VK_LEFT

::cBuffer:= ""

If ::GoLeft()

::Refresh()

EndIf

case nKey == VK_RIGHT

::cBuffer:= ""

If ::GoRight()

::Refresh()

EndIf

case nKey == VK_HOME

::cBuffer:= ""

::GoTop()

case nKey == VK_END

::cBuffer:= ""

::GoBottom()

case nKey == VK_PRIOR

::cBuffer:= ""

if GetKeyState( VK_CONTROL )

::GoTop()

else

::PageUp()

endif

case nKey == VK_NEXT

::cBuffer:= ""

if GetKeyState( VK_CONTROL )

::GoBottom()

else

::PageDown()

endif

case ::bSeek != Nil .and. !::lWorking .and. nKey == VK_BACK

::lWorking:= .T.

::cBuffer := SubStr( ::cBuffer, 1, Len(::cBuffer) - 1 )

if "L" $ ValType( lRefresh:= Eval( ::bSeek ) ) .and. lRefresh

::nRowPos:= Max( Min( ::nLen, ::nRowCount ), 1 )

::Refresh()

endif

::lWorking:= .F.

case ::bSeek != Nil .and. ( nKey == VK_SHIFT .or. nKey >= 32 )

// No Hacer nada !!!, pero respetar el Super.

Super:KeyDown( nKey, nFlags )

otherwise

::cBuffer:= ""

If( ::bSeek != Nil .and. ::bUpdateBuffer != Nil, Eval( ::bUpdateBuffer ), )

return Super:KeyDown( nKey, nFlags )

endcase

If( ::bSeek != Nil .and. ::bUpdateBuffer != Nil, Eval( ::bUpdateBuffer ), )

return 0

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

METHOD DbfSeek( lSoftSeek, bEof, nLenBuffer, lUpper, cBuffer ) CLASS TWBrowse

local nRecNo := (::cAlias)->( Recno() )

DEFAULT lSoftSeek := .T., ;

bEof:= {|| .T. }, ;

lUpper:= .T.,;

cBuffer:= ::cBuffer

cBuffer:= If( ! lUpper, cBuffer, Upper( cBuffer ) )

If nLenBuffer != Nil

cBuffer:= SubStr( cBuffer, 1, nLenBuffer )

EndIf

If Len( cBuffer ) > 0 .and. ! Empty( cBuffer )

(::cAlias)->( DbSeek( cBuffer, lSoftSeek ) )

if nRecNo != (::cAlias)->( Recno() )

if ( ::cAlias ) ->( Eof() )

( ::cAlias ) -> ( DbGoto( nRecNo ) )

Eval( bEof )

else

return .T.

endif

endif

EndIf

return .F.

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

METHOD KeyChar( nKey, nFlags ) CLASS TWBrowse

LOCAL lRefresh

do case

case nKey == K_PGUP

::cBuffer:= ""

::oVScroll:PageUp()

case nKey == K_PGDN

::cBuffer:= ""

::oVScroll:PageDown()

case ::bSeek != Nil .and. !::lWorking .and. nKey >= 32 ;

.and. ! Chr(nKey)$"+-/*"

::lWorking:= .T.

if Len( ::cBuffer ) < ::nBuffer

::cBuffer += Chr( nKey )

if "L" $ ValType( lRefresh:= Eval( ::bSeek ) ) .and. lRefresh

::nRowPos:= Max( Min( ::nLen, ::nRowCount ), 1 )

::Refresh()

endif

endif

::lWorking:= .F.

otherwise

return Super:KeyChar( nKey, nFlags )

endcase

If( ::bSeek != Nil .and. ::bUpdateBuffer != Nil, Eval( ::bUpdateBuffer ), )

return 0

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

METHOD PageUp( nLines ) CLASS TWBrowse

local nSkipped

DEFAULT nLines := ::nRowCount()

nSkipped = ::Skip( -nLines )

if ( ::nLen := Eval( ::bLogicLen ) ) < 1

return nil

endif

if ! ::lHitTop

if nSkipped == 0

::lHitTop = .t.

else

::lHitBottom = .f.

if -nSkipped < nLines

::nRowPos = 1

if ::oVScroll != nil

If ::bLogicPos != Nil // By CeSoTech

::oVScroll:SetPos( _POSVSCROLL_ )

Else

::oVScroll:SetPos( 1 )

EndIf

endif

else

nSkipped = ::Skip( -nLines )

::Skip( -nSkipped )

if ::oVS

[kapiaba]

Desculpe a sinceridade:

A primeira coisa que um programador aprende, é a LER.

Se bem que não é o meu caso... kkkkkkkkkkkk

Veja:

Modificaciones y Agregados a la TWBrowse version FW2.1

Portanto, eu acho que não é 32 bits.

João Santos - São Paulo.

kmt_karinha@pop.com.br

joao@pleno.com.br

Fone: (11) 3106-2832 / 8243-5632

FWH 2.7 - xHARBOUR WorkShop.Exe

[Luiz Arruda (ICO)]

SDINFO..

Primeiro coloque no seu perfil quais as ferramentas que vc. tá usando. Assim fica melhor para ajudar tipo, veja o perfil do Kapi e a minha.. Dependendo da sua versão ao invés de incluir alguma coisa basta retirar e usar a Classe Nativa do FiveWin que vai Funcionar..

Para converter o seu sistema 16 para 32, Não necessáriamente os browse devem ficar identicos, em versões novas usando o TwBrowse Nativa ele pode ficar até melhor do a de terceiros..

Não vai adiantar vc ir apenas trocando as classes 16 por uma de 32 bits, vc. terá que reescrever alguma coisa Também.

Com os codigos na mão e vc. reescrevendo alguma coisa, quando terminar vc. vai estar tirando de letra o FW.

Pense Nisso

Abraços..

Retorne avisando se a dica funcionouid=red>

Luiz Arruda

Corumbá - MS

ico.corumba@gmail.com

" Vocês Podem ter todo o dinehiro do mundo!!, mais uma coisa vocês nunca irão ter!!

um elefante!"

[AVInfo Sistemas]

vamos lá ...

o codígo que estou tentando migrar foi desenvolvido em

fw for clipper 2.2, resourcer 16 bits no workshop.exe

e atualmente estou usando o fw10.02 xharbor 12.1 , e tentando usar o pelles.exe

isso ajuda ?

[kapiaba]

Tudo o que voce estiver usando de terceiros em 16 bits, deve ter em 32 em dicas mais dicas(pagina principal)

ex.:

http://www.fivewin.com.br/exibedicas.asp?id=884

João Santos - São Paulo.

kmt_karinha@pop.com.br

joao@pleno.com.br

Fone: (11) 3106-2832 / 8243-5632

FWH 2.7 - xHARBOUR WorkShop.Exe

[AVInfo Sistemas]

amigos ... desculpem novamente ... como eu disse ainda sou leigo em fivewin. Então eu preciso que vcs me ajudem com relação a esses problemas com um pouco mais d clareza c possível. Como eu posso incorporar a wbrowse 32 bits ao invés da 16 bits no meu projeto? Simplesmente substituo o WBROWSE.PRG de 16 pelo 32 no meu projeto ou preciso de algum outro arquivo específico tipo um .lib ou .ch sei lá?

[kapiaba]

citação:

amigos ... desculpem novamente ... como eu disse ainda sou leigo em fivewin. Então eu preciso que vcs me ajudem com relação a esses problemas com um pouco mais d clareza c possível. Como eu posso incorporar a wbrowse 32 bits ao invés da 16 bits no meu projeto? Simplesmente substituo o WBROWSE.PRG de 16 pelo 32 no meu projeto ou preciso de algum outro arquivo específico tipo um .lib ou .ch sei lá?

---

id=quote>id=quote>

Sua resposta é SIM!

Ou simplesmente deixe de usar WBROWSE.PRG do HERNAN(Terceiros) e use a WBROWSE.PRG NATIVA DO FIVEWIN.

Voce pode ve-la em C:\FWH\SOURCE\CLASSES.

é isso.

Abraços.

João Santos - São Paulo.

kmt_karinha@pop.com.br

joao@pleno.com.br

Fone: (11) 3106-2832 / 8243-5632

FWH 2.7 - xHARBOUR WorkShop.Exe

[AVInfo Sistemas]

desculpe ficar amolando vcs aqui no forum, mas eu realmente estou perdido. Eu fiz o que disse substitui a wbrowse no meu projeto agora como eu posso começar a tentar resolver os erros de compilação. Começando pelo erro que aparece na linha sublinhada na img por favor ?

[kapiaba]

Olá,

Voce ainda está com a WBROWSE.PRG Errada, pegue uma de 32 bits, ou retire-a do projeto e use a WBROWSE.PRG original do FIVE.

Quanto ao FWBACKUP.PRG, esqueça, não poderá usá-lo mais em 32 bits, pois não existe versão para ele.

Em dicas mais dicas eu postei um novo backupeador.

XBLITE.PRG, que substitui o FWBACKUP.PRG

João Santos - São Paulo.

kmt_karinha@pop.com.br

joao@pleno.com.br

Fone: (11) 3106-2832 / 8243-5632

FWH 2.7 - xHARBOUR WorkShop.Exe

[AVInfo Sistemas]

Bom, substitui a wbrowse pela nativa do fwh mas persiste os erros. Para provar esta abaixo a imagem do projeto com o caminho da wbrowse nativa adicionada ao projeto. Bom a outra alternativa, também procurei a wbrowse d 32 bits mas não encontrei, e como eu sei q ela é 32 e não 16 ?

[kapiaba]

Eu acho que voce não entendeu:

Veja os exemplos usando WBROWSE.PRG nativa.

Estes comandos recusados, é porque não existem na WBROWSE.PRG nativa.

Faça o seguinte, peça a alguém uma WBROWSE.PRG do Hernan, atualizada.

João Santos - São Paulo.

kmt_karinha@pop.com.br

joao@pleno.com.br

Fone: (11) 3106-2832 / 8243-5632

FWH 2.7 - xHARBOUR WorkShop.Exe

[AVInfo Sistemas]

Kra eu não to entendendo o seguinte, existe uma .prg criada pelo meu chefe que o compilador não consegue encontrar, veja a linha sublinhada no console do compilador e o .prg contendo a bendita da função na tela. O q pode ser meu amigo ????

[kapiaba]

CADE CHECK.PRG???

João Santos - São Paulo.

kmt_karinha@pop.com.br

joao@pleno.com.br

Fone: (11) 3106-2832 / 8243-5632

FWH 2.7 - xHARBOUR WorkShop.Exe

[AVInfo Sistemas]

ta ae kra ... e o moodulo principal do projeto

[AVInfo Sistemas]

alguma sugestão gente ??? por favor ???

[kapiaba]

citação:

alguma sugestão gente ??? por favor ???

---

id=quote>id=quote>

MOSTRE AS LINHAS 1300 A 1500 DE CHECK.PRG CONTEM ERROS.

João Santos - São Paulo.

kmt_karinha@pop.com.br

joao@pleno.com.br

Fone: (11) 3106-2832 / 8243-5632

FWH 2.7 - xHARBOUR WorkShop.Exe

Editado por - kapiaba on 29/10/2010 09:00:11

[gss200610]

PRIMEIRO, PQ AO INVEZ DE USAR SENSITIVE SAY VC NAO USA STSAY

QUE É DO ARQUIVO SSAY.CH, ISSO DEVE RESOLVER.

SEGUNDO, ESSE ERRO DO OLEUNITIALIZE TIVE ISSO USANDO O TSBROWSE, MAIS O MANUEL MERCADO POSTOU NO FORUM INTERNACIONAL Q VC DEVERIA COMENTAR ESSAS LINHAS NO SOURCE DO TSBROWSE E RESOLVEU.

Gilmar Silva Santos

Programador - Goiânia Go

Não Recuarei, Nada Temerei, Comigo Está o Senhor.

[AVInfo Sistemas]

........

IF EMPTY(CONTROLE->ID)

cPasta := ".\DADOS"

ENDIF

IF EMPTY(CONTROLE->LOGO)

clLogo := ".\BITMAPS\LOGOAV1.BMP"

ENDIF

nId := SPACE(10)

oSen1:= SPACE(10)

oSen2:= SPACE(10)

cIniFile := ".\Check.INI"

cLogoBmp := ALLTRIM( GetPvProfString(STRZERO(nEmpr,10), "LogoMarca", "LOGOAV1.BMP", cIniFile ))

cFootBmp := ALLTRIM( GetPvProfString(STRZERO(nEmpr,10), "FootImage", "FOOTIMPR.BMP", cIniFile ))

cLogType := ALLTRIM( GetPvProfString(STRZERO(oCod,10), "TipoLogo", "NORMAL", cIniFile ))

if empty(CONTROLE->ID)

if rlock()

replace CONTROLE->ID with SPACE(10)

endif

endif

DEFINE FONT oFootFn NAME "Courier New" SIZE 0,-10

DEFINE DIALOG oDlg RESOURCE "USUARIO"

oDlg:lHelpIcon := .F.

REDEFINE GET oCt01 VAR oCod PICTURE "99" ID 42 OF oDlg READONLY

REDEFINE GET oCt02 VAR oUsu ID 33 OF oDlg

REDEFINE GET oCt03 VAR oRaz ID 34 OF oDlg

REDEFINE GET oCt04 VAR oCgc ID 35 OF oDlg

REDEFINE GET oCt59 VAR oIE ID 59 OF oDlg

REDEFINE GET oCt62 VAR oIM ID 62 OF oDlg

REDEFINE GET oCt05 VAR oEnd ID 36 OF oDlg

REDEFINE GET oCt06 VAR oBai ID 38 OF oDlg

REDEFINE GET oCt06 VAR oCid ID 39 OF oDlg

REDEFINE GET oCt07 VAR oUf ID 40 OF oDlg

REDEFINE GET oCt08 VAR oCep ID 41 OF oDlg

REDEFINE GET oCt09 VAR oTel ID 43 OF oDlg

REDEFINE GET oCt63 VAR cPnom ID 63 OF oDlg

REDEFINE GET oCt64 VAR cPcpf ID 64 OF oDlg

REDEFINE GET oCt65 VAR cPrg ID 65 OF oDlg

REDEFINE GET oCt66 VAR mHpage ID 66 OF oDlg

REDEFINE GET oCt67 VAR mEmail ID 67 OF oDlg

REDEFINE GET oCt10 VAR mF_end ID 45 OF oDlg

REDEFINE GET oCt11 VAR mF_bai ID 46 OF oDlg

REDEFINE GET oCt12 VAR mF_cid ID 47 OF oDlg

REDEFINE GET oCt13 VAR mF_cep ID 48 OF oDlg

REDEFINE GET oCt14 VAR mF_lem ID 50 OF oDlg FONT oFootFn

REDEFINE GET oCt15 VAR mF_ob1 ID 51 OF oDlg FONT oFootFn

REDEFINE GET oCt16 VAR mF_ob2 ID 52 OF oDlg FONT oFootFn

REDEFINE GET oCt17 VAR mF_ob3 ID 53 OF oDlg FONT oFootFn

REDEFINE GET oCt18 VAR nId ID 55 OF oDlg Valid ChkUsrSen(@oId,@nId,@lOk,oDlg)

REDEFINE GET oCt19 VAR oSen1 ID 56 OF oDlg UPDATE WHEN lOk = .T.

REDEFINE GET oCt20 VAR oSen2 ID 57 OF oDlg UPDATE WHEN lOk = .T.;

VALID EVAL({||IF(oSen2 == oSen1,NIL,;

(MsgStop(OemToAnsi("Senhas nÆo conferem"),"Erro"),;

oSen1:=SPACE(10),oSen2:=SPACE(10),oDlg:Update())),.T.})

REDEFINE BUTTON oCt21 ID 37 OF oDlg ACTION ( lSave := .t. , oDlg:End() ) WHEN !EMPTY(oUsu) .AND. !EMPTY(oEnd) .AND. !EMPTY(oCid) .AND. !EMPTY(oUf) .AND. !EMPTY(oCgc) .AND. !EMPTY(oTel) .AND. EVAL({||(NIL),IIF(lOk,!EMPTY(oSen1) .AND. !EMPTY(oSen2),.T.)})

REDEFINE BUTTON oCt21 ID 58 OF oDlg ACTION ( IIF(New=.T.,DBDELETE(),NIL), oDlg:End() )

ACTIVATE DIALOG oDlg ON INIT IF(aRec[4] >= 800,oDlg:Center(),NIL)

oFootFn:End()

IF lSave

IF ! EMPTY(oSen1) ; oId := oSen1 ; ENDIF

WHILE ! CONTROLE->(Rlock()) ; end

REPLACE CONTROLE->CODIGO WITH oCod

REPLACE CONTROLE->USUARIO WITH oUsu

REPLACE CONTROLE->RAZAO WITH oRaz

REPLACE CONTROLE->FANTASIA WITH oCid

REPLACE CONTROLE->TELEFONE WITH oTel

REPLACE CONTROLE->ENDERECO WITH oEnd

REPLACE CONTROLE->CGC WITH oCgc

REPLACE CONTROLE->IE WITH oIE

REPLACE CONTROLE->IM WITH oIM

REPLACE CONTROLE->BAIRRO WITH oBai

REPLACE CONTROLE->CIDADE WITH oCid

REPLACE CONTROLE->UF WITH oUf

REPLACE CONTROLE->CEP WITH oCep

REPLACE CONTROLE->PROPRI WITH cPnom

REPLACE CONTROLE->PROCPF WITH cPcpf

REPLACE CONTROLE->PRORG WITH cPrg

REPLACE CONTROLE->HPAGE WITH mHpage

REPLACE CONTROLE->EMAIL WITH mEmail

REPLACE CONTROLE->F_END WITH mF_end

REPLACE CONTROLE->F_BAIRRO WITH mF_bai

REPLACE CONTROLE->F_CIDADE WITH mF_cid

REPLACE CONTROLE->F_CEP WITH mF_cep

REPLACE CONTROLE->LEMA WITH mF_lem

REPLACE CONTROLE->OBS1 WITH mF_ob1

REPLACE CONTROLE->OBS2 WITH mF_ob2

REPLACE CONTROLE->OBS3 WITH mF_ob3

REPLACE CONTROLE->ID WITH oId

REPLACE CONTROLE->LOGO WITH clLogo

IF EMPTY(CONTROLE->DADOS)

REPLACE CONTROLE->DADOS WITH cPasta

ENDIF

SysRefresh()

endif

WritePProS( STRZERO(oCod,10), "LogoMarca", cLogoBmp, cIniFile )

WritePProS( STRZERO(oCod,10), "FootMarca", cFootBmp, cIniFile )

WritePProS( STRZERO(oCod,10), "TipoLogo", cLogType, cIniFile )

CONTROLE->(DbUnlock())

mEmp := ALLTRIM(CONTROLE->USUARIO)

oRaz := ALLTRIM(CONTROLE->RAZAO)

mEnd := Alltrim(CONTROLE->ENDERECO)+"-"+Alltrim(CONTROLE->BAIRRO)

cCep := ALLTRIM(CONTROLE->CEP)

mCid := Alltrim(CONTROLE->FANTASIA)+"-"+CONTROLE->UF+" - CEP: "+CONTROLE->CEP

mFon := "TEL/FAX : "+Alltrim(CONTROLE->TELEFONE)

nCgc := "CGC/CNPJ: "+Alltrim(CONTROLE->CGC)

cIE := "I.E: "+Alltrim(CONTROLE->IE)

cIM := "I.Mun: "+Alltrim(CONTROLE->IM)

mHpage := ALLTRIM(CONTROLE->HPAGE)

mEmail := ALLTRIM(CONTROLE->EMAIL)

cPnom:= CONTROLE->PROPRI

cPcpf:= CONTROLE->PROCPF

cPrg := CONTROLE->PRORG

mF_end:=CONTROLE->F_END

mF_bai:=CONTROLE->F_BAIRRO

mF_cid:=CONTROLE->F_CIDADE

mF_cep:=CONTROLE->F_CEP

mF_lem:=CONTROLE->LEMA

mF_ob1:=CONTROLE->OBS1

mF_ob2:=CONTROLE->OBS2

mF_ob3:=CONTROLE->OBS3

clLogo := CONTROLE->LOGO

cFrase2:=mF_ob1

cFrase3:=mF_ob2

cFrase4:=mF_ob3

RETURN NIL

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

Function ChkUsrSen(oId,nId,lOk,oDlg)

IF oId != nId

MsgAlert(OemToAnsi('Senha incorreta. NÆo ser  poss¡vel alterar a senha'),OemToAnsi('Atenção') )

lOk := .f.

ELSE

lOk := .T.

endif

oDlg:UpDate()

RETURN .T.

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

function SetBrush( cStyle, nRGBColor )

local oBrush

// FiveWin new predefined Brushes don't need colors

// Windows standard brushes support colors

if nRGBColor == nil

DEFINE BRUSH oBrush STYLE ( cStyle )

else

DEFINE BRUSH oBrush STYLE ( cStyle ) COLOR nRGBColor

endif

SET BRUSH OF oWnd TO oBrush

USE FUNDOS NEW

GO TOP

REPLACE PREDEF WITH cStyle

REPLACE SOLIDR WITH 0

REPLACE SOLIDG WITH 0

REPLACE SOLIDB WITH 0

REPLACE COR WITH 0

REPLACE BITMAP WITH ""

REPLACE DLL WITH 0

CLOSE FUNDOS

return nil

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

function BmpBrush()

local cBitmap := cGetFile( "*.bmp", "Selecione um Bitmap" )

local oBrush

if ! Empty( cBitmap )

DEFINE BRUSH oBrush FILE cBitmap

SET BRUSH OF oWnd TO oBrush

USE FUNDOS NEW

GO TOP

REPLACE PREDEF WITH ""

REPLACE SOLIDR WITH 0

REPLACE SOLIDG WITH 0

REPLACE SOLIDB WITH 0

REPLACE COR WITH 0

REPLACE BITMAP WITH cBitmap

REPLACE DLL WITH 0

CLOSE FUNDOS

endif

return nil

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

procedure Solido( nR, nG, nB )

DEFINE BRUSH oBrush COLOR nRGB( nR, nG, nB )

SET BRUSH OF oWnd TO oBrush

USE FUNDOS NEW

GO TOP

REPLACE PREDEF WITH ""

REPLACE SOLIDR WITH nR

REPLACE SOLIDG WITH nG

REPLACE SOLIDB WITH nB

REPLACE COR WITH 0

REPLACE BITMAP WITH ""

REPLACE DLL WITH 0

CLOSE FUNDOS

return

id=code>id=code>

[kapiaba]

MOSTRE-ME A LINHA 1351 DE CHECK.PRG, MAS ANTES TENTE COMPILAR SOMENTE COM /M /N.

João Santos - São Paulo.

kmt_karinha@pop.com.br

joao@pleno.com.br

Fone: (11) 3106-2832 / 8243-5632

FWH 2.7 - xHARBOUR WorkShop.Exe

[AVInfo Sistemas]

desculpe a ignorância mas como eu faço isso no xDev ?

[AVInfo Sistemas]

REDEFINE BUTTON oCt21 ID 37 OF oDlg ACTION ( lSave := .t. , oDlg:End() ) WHEN !EMPTY(oUsu) .AND. !EMPTY(oEnd) .AND. !EMPTY(oCid) .AND. !EMPTY(oUf) .AND. !EMPTY(oCgc) .AND. !EMPTY(oTel) .AND. EVAL({||(NIL),IIF(lOk,!EMPTY(oSen1) .AND. !EMPTY(oSen2),.T.)})

(Linha 1351)

[kapiaba]

citação:

desculpe a ignorância mas como eu faço isso no xDev ?

---

id=quote>id=quote>

Pergunte a alguém que usa a XDEV.EXE

// Tente assim, e se nao funcionar comente o WHEN para ver se passa a

// compilacao

REDEFINE BUTTON oCt21 ID 37 OF oDlg ;

ACTION ( lSave := .t. , oDlg:End() ) ;

WHEN( !EMPTY(oUsu) .AND. ;

!EMPTY(oEnd) .AND. ;

!EMPTY(oCid) .AND. ;

!EMPTY(oUf) .AND. ;

!EMPTY(oCgc) .AND. ;

!EMPTY(oTel) .AND. ;

EVAL({||(NIL),IIF(lOk,!EMPTY(oSen1) .AND. ;

!EMPTY(oSen2),.T.)}) )

id=code>id=code>

João Santos - São Paulo.

kmt_karinha@pop.com.br

joao@pleno.com.br

Fone: (11) 3106-2832 / 8243-5632

FWH 2.7 - xHARBOUR WorkShop.Exe

Editado por - kapiaba on 29/10/2010 11:06:43

[eevaldo]

Ola,

O xdev por default so compila o programa que voce alterou.

Obrigado.

Evaldo Wagner

FiveWin9.07 xHarbour 1.21,BCC55, Pelles C xDev,xHarbour for Linux(console)

evaldowl@hotmail.com

[AVInfo Sistemas]

não sei mas o q eu faço ... Bom eu fiz o que me pediu kapiaba mas sem resultado.. as advertências sobre os problemas com a linha problemática sumiram, porem os erros não. O Compilador nem reconhecendo uma função de um .prg criado pelo meu chefe está reconhecendo. To perdido, já to pegando o meu terço aqui e providenciando "o meu pai nosso que estais no céu ...." rssss...

[kapiaba]

ele gera um ERRO.LOG??

Poste aqui.

João Santos - São Paulo.

kmt_karinha@pop.com.br

joao@pleno.com.br

Fone: (11) 3106-2832 / 8243-5632

FWH 2.7 - xHARBOUR WorkShop.Exe