TWBROWSE - bkeydown não aceita VK_UP?

[FWHISHOW]

TWBROWSE - bkeydown não aceita VK_UP ?


Obrigado

[Antonio Linares]

Tienes que modificar el código del método KeyDown():

Code: Select all  Expand view

METHOD KeyDown( nKey, nFlags ) CLASS TWBrowse

   if ::bKeyDown != nil   // nuevo
      Eval( ::bKeyDown, nKey )  // nuevo
   endif  // nuevo

   do case
      case nKey == VK_UP
           ::GoUp()
   ...


[FWHISHOW]

grato Antonio!

[FWHISHOW]

Antonio, adicionei o código e funcionou, porém ao editar uma célula (leditcol), agora estou tendo que apertar a tecla ESC duas vezes para sair da edição?


MINHA TWBROWE:

// 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
// b) .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.
// 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 -)
//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( <nCol> ). 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 -.
//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( [ <uParam> ] )
// <uParam> 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 -
// 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
////---20/02/2004---Revision 16.-
// 56) Fixes en VScroll y HScroll en ambientes de 32 bits
// 57) Implementacion de MouseWheel() de Fivewin en ambientes no 16 bits
// 58) Aumento de Velocidad. Minimización a la máxima expresión de las llamadas de calculos
// de Nros. de Registros en Tabla ( ::bLogicLen )
////---18/08/2004---Revision 17.-
// 59) El Bloque bChange no se ejecutaba en busquedas incrementales automaticas.
// 60) Metodo VerifyLogicLen( nLogicLen ) de uso interno, sirve para determinar si realmente existen
// registros en una base de datos.
// 61) Fixes de compatibilidad con xHarbour/Harbour y fixes varios de clase
// 62) Tecnica de doble buffer




#xtranslate __LOGIC_LEN__ => ;
( if( ::lLogicLen, ( n:= ::VerifyLogicLen(Eval( bLogicLen )),;
::lLogicLen:= .F.,;
if( "N"$ValType(n), ::nLogicLen:= n, nil ) ) ,nil ),;
::nLogicLen )



#xtranslate __LOGIC_POS__ => ;
( if( ::lLogicPos, ( n:= Eval( bLogicPos ),;
::lLogicPos:= .F.,;
if( "N"$ValType(n), ::nLogicPos:= n, nil ) ) ,nil ),;
::VerifyLogicPos(::nLogicPos) )




#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"
#INCLUDE "BTNGET.ch"

#define MK_MBUTTON 16

#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 aSkipCol // no posicionamiento de columnas // fjhg 28-may-07
DATA lFreeze INIT .T. // no posicionamiento en columnas freeze // fjhg 28-may-07

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 lMouseWheel INIT .t. // AAL .F. para evitar refresh en browses asociados
DATA lVScrollMove INIT .t. // AAL y posible desbordamiento de stack

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 lFirst INIT .f. // AAL


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

DATA nLogicLen INIT 0 // CeSoTech
DATA lLogicLen INIT .T. // CeSoTech
DATA nLogicPos INIT 0 // CeSoTech
DATA lLogicPos INIT .T. // CeSoTech
DATA lGoTop INIT .F.
DATA lGoBottom INIT .F.

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, aSkipCol ) 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, aSkipCol ) 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 )
#ifndef __CLIPPER__
METHOD MouseWheel( nKeys, nDelta, nXPos, nYPos )
#endif
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 SetSizes()
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 )
METHOD VerifyLogicLen( nLogicLen )
METHOD VerifyLogicPos( nLogicPos )
METHOD DispBegin( lCreateDC ) // ( [lCreateDC] ) --> aInfo
METHOD DispEnd( aInfo )

ENDCLASS


//----------------------------------------------------------------------------//
METHOD nRowCount() CLASS TWBrowse
_WBRWSET_

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, aSkipCol ) 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() }

::aSkipCol = aSkipCol

::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_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, aSkipCol ) 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.

::aSkipCol = aSkipCol

::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_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

local aInfo


_WBRWSET_
if ::lIconView
::DrawIcons()
return 0
endif

aInfo:= ::DispBegin()

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

::DispEnd( aInfo )


If ::oVScroll != Nil .and. ::bLogicPos != Nil
if ::lHitTop .or. ( ::nLogicPos!= nil .and. ::nLogicPos <= 1 ) .or. ::lGoTop .or. ::nLen <= 1
::oVScroll:SetPos( 1 )
elseif ::lHitBottom .or. ::lGoBottom
::oVScroll:SetPos( 100 )
else
::oVScroll:SetPos( _POSVSCROLL_ )
endif
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()
local aInfo

_WBRWSET_
::lGoTop:= .F.
::lGoBottom:= .F.

if ( ::nLen := Eval( ::bLogicLen ) ) < 1
return nil
endif


if ! ::lHitTop

aInfo:= ::DispBegin( .T. )

::DrawLine()
if ::Skip( -1 ) == -1
::lHitBottom = .f.
if ::nRowPos > 1
::nRowPos--
else
WBrwScrl( ::hWnd, -1, If( ::oFont != nil, ::oFont:hFont, 0 ), ::nLineStyle, ::hDC )
endif
::nLogicPos--
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


::DispEnd( aInfo )

endif


return nil

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

METHOD GoDown() CLASS TWBrowse

local nSkipped
local nLines := ::nRowCount()
local aInfo


_WBRWSET_
::lGoTop:= .F.
::lGoBottom:= .F.

if ( ::nLen := Eval( ::bLogicLen ) ) < 1
return nil
endif


if ! ::lHitBottom

aInfo:= ::DispBegin( .T. )

::DrawLine()
if ::Skip( 1 ) == 1
::lHitTop = .f.
if ::nRowPos < nLines
::nRowPos++
else
WBrwScrl( ::hWnd, 1, If( ::oFont != nil, ::oFont:hFont, 0 ), ::nLineStyle, ::hDC )
endif
::nLogicPos++
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

::DispEnd( aInfo )

endif



return nil

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

METHOD GoLeft( lRefresh ) CLASS TWBrowse // by CeSoTech
LOCAL aSizes:= ::GetColSizes()
LOCAL nCols := Len( aSizes )
LOCAL lColVisible, nColAct, lRefreshAll:= .t.
LOCAL lGoLeft:= Eval( ::bGoLeft )
LOCAL FWHUltCol:=0

DEFAULT lRefresh:= .T.

_WBRWSET_

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 lRefresh
If( ::nLen > 0, ::Refresh(), )
endif
Else

// ::nColAct--
// lColVisible:= !( aSizes[::nColAct] == 0 )
// aSizes[::nColAct]:= ::aTmpColSizes[::nColAct]

While .t. .AND. ::nColAct>0 // AAL ocultar
::nColAct--
aSizes[::nColAct]:= ::aTmpColSizes[::nColAct]
lColVisible:= ( aSizes[::nColAct] == 0 )
IF !lColVisible
exit
ENDIF
EndDo

// fjhg 28-may-07
IF ::lFreeze
::nColAct:=IF(::lFirst .AND. ::nColAct=::nFreeze,(::nFreeze + 1),;
IF(::nColAct=::nFreeze,(::nFreeze + 1),::nColAct))
ELSE
::nColAct:=IF(::lFirst .AND. ::nColAct=1,2,::nColAct)
ENDIF


if lRefresh
If !lColVisible
If( ::nLen > 0, ::Refresh(), )
Else
lRefreshAll:= .f.
If( ::nLen > 0, ::DrawSelect(), )
EndIf
endif
EndIf

Else // No tiene Columnas Freeze

If !::lCellStyle
::nColAct--
::nColPos--
If( ::nLen > 0, ::Refresh(), )

Else
::nColAct--
lColVisible:= .t.
::nColAct:=IF(::lFirst .AND. ::nColAct=1,2,::nColAct)
While .t.
If ! ::IsColVisible( ::nColAct ) .and. ::nColAct < ::nColPos
lColVisible:= .f.
::nColPos--
Loop
Else
Exit
EndIf
EndDo

//bira 21/11/07 - quando edicao e acolsizes era = 0,não pulava a coluna
//faço isso agora com as linhas abaixo.

FWHUltCol:=0
for x:=Len(aSizes) to 1 step -1
IF !( aSizes[x] == 0 )
FWHUltCol:=x
endif
next
While .t. .AND. ::nColAct<Len(aSizes)
IF !( aSizes[::nColAct] == 0 )
exit
else
lColVisible:=.f.
if ::nColAct > 1
::nColAct--
else
exit
endif
ENDIF
EndDo
IF aSizes[::nColAct] == 0
::nColAct:=FWHUltCol
lColVisible:=.f.
endif
//fim bira 21/11/07

if lRefresh
If !lColVisible
If( ::nLen > 0, ::Refresh(), )
Else
lRefreshAll:= .f.
If( ::nLen > 0, ::DrawSelect(), )
EndIf
endif
EndIf

EndIf

If ::oHScroll != Nil .and. lRefresh
::oHScroll:SetPos( ::nColAct )
EndIf

EndIf
return lRefreshAll

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

METHOD GoRight( lRefresh ) CLASS TWBrowse // by CeSoTech
LOCAL aSizes:= ::GetColSizes()
LOCAL nCols := Len( aSizes )
LOCAL lColVisible, nColAct, lRefreshAll:= .t.
LOCAL lGoRight:= Eval( ::bGoRight )
LOCAL FWHUltCol:=0

DEFAULT lRefresh:= .T.

_WBRWSET_

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 lRefresh
If( ::nLen > 0, ::Refresh(), )
endif
EndIf
Else
// lColVisible:= .t.
// ::nColAct++

While .t. .AND. ::nColAct<Len(aSizes) // AAL ocultar
::nColAct++
lColVisible:= !( aSizes[::nColAct] == 0 )
IF lColVisible
exit
ENDIF
EndDo

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 lRefresh
If !lColVisible
If( ::nLen > 0, ::Refresh(), )
Else
lRefreshAll:= .f.
If( ::nLen > 0, ::DrawSelect(), )
EndIf
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

//bira 21/11/07 - quando edicao e acolsizes era = 0,não pulava a coluna
//faço isso agora com as linhas abaixo.
FWHUltCol:=0
for x:=1 to Len(aSizes)
IF !( aSizes[x] == 0 )
FWHUltCol:=x
endif
next
While .t. .AND. ::nColAct<Len(aSizes)
IF !( aSizes[::nColAct] == 0 )
exit
else
::nColAct++
lColVisible:=.f.
ENDIF
EndDo
IF aSizes[::nColAct] == 0
::nColAct:=FWHUltCol
lColVisible:=.f.
endif
//fim bira 21/11/07

if lRefresh
If !lColVisible
If( ::nLen > 0, ::Refresh(), )
Else
lRefreshAll:= .f.
If( ::nLen > 0, ::DrawSelect(), )
EndIf
endif
EndIf

EndIf

If ::oHScroll != Nil .and. lRefresh
::oHScroll:SetPos( ::nColAct )
EndIf

EndIf
return lRefreshAll

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

METHOD GoTop() CLASS TWBrowse

local aInfo

::lGoTop:= .T.
::lGoBottom:= .F.

_WBRWSET_

if ( ::nLen := Eval( ::bLogicLen ) ) < 1
return nil
endif

if ! ::lHitTop

aInfo:= ::DispBegin( .T. )

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

::DispEnd( aInfo )

endif

return nil

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

METHOD GoBottom() CLASS TWBrowse

local nSkipped
local nLines // := ::nRowCount()
local n
local aInfo

::lGoTop:= .F.
::lGoBottom:= .T.

_WBRWSET_ // by CeSoTech
nLines := ::nRowCount() // " "
::lLogicPos:= .T.

if ( ::nLen := Eval( ::bLogicLen ) ) < 1
return nil
endif

if ! ::lHitBottom

aInfo:= ::DispBegin( .T. )

::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

::DispEnd( aInfo )

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 .and. nBrwCol > 0
::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
::lGoTop:= .F.
::lGoBottom:= .F.
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

[Antonio Linares]

Para evitar que se ejecute dos veces haz lo siguiente:

Code: Select all  Expand view

METHOD KeyDown( nKey, nFlags ) CLASS TWBrowse

   local uRet

   if ::bKeyDown != nil   // nuevo
      uRet := Eval( ::bKeyDown, nKey )  // nuevo
      if ValType( uRet ) == "L" .and. uRet
         return nil
      endif
   endif  // nuevo

   do case
      case nKey == VK_UP
           ::GoUp()
   ...


Así ahora bKeyDown tiene que devolver .T. para que no continúe la ejecución del método KeyDown().

[FWHISHOW]

Antonio, testando o seu exemplo, uRet retorna sempre VALTYPE(uRet) "U", não esta funcionando!


Obrigado

[Antonio Linares]

oBrowse:bKeyDown = { | nKey | If( nKey == VK_UP, ( MsgInfo( "Up" ), .T. ),) }

[FWHISHOW]

Desculpe antonio, acredito que minha classe twbrowse não esta legal, usted poderia me indicar uma classe funcional para download?



Obrigado

[Antonio Linares]

La Clase TWBrowse está incluida en FWH y su código fuente está en fwh\source\classes\wbrowse.prg

[FWHISHOW]

grato