TWBROWSE - bkeydown não aceita VK_UP ?
Obrigado
FiveTech Support Forums
FiveWin / Harbour / xBase community
Board index FiveWin para Harbour/xHarbour TWBROWSE - bkeydown não aceita VK_UP?
Tienes que modificar el código del método KeyDown():
METHOD KeyDown( nKey, nFlags ) CLASS TWBrowse
if ::bKeyDown != nil // nuevo
Eval( ::bKeyDown, nKey ) // nuevo
endif // nuevo
do case
case nKey == VK_UP
::GoUp()
...grato Antonio!
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 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( <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 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( [ <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 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
////---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 <!-- s:-) --><img src="{SMILIES_PATH}/icon_smile.gif" alt=":-)" title="Smile" /><!-- s:-) --> que la cabeza no solo
////////////// es para pinarnos <!-- s:-) --><img src="{SMILIES_PATH}/icon_smile.gif" alt=":-)" title="Smile" /><!-- s:-) -->
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
Para evitar que se ejecute dos veces haz lo siguiente:
Asà ahora bKeyDown tiene que devolver .T. para que no continúe la ejecución del método KeyDown().
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().
Antonio, testando o seu exemplo, uRet retorna sempre VALTYPE(uRet) "U", não esta funcionando!
Obrigado
oBrowse:bKeyDown = { | nKey | If( nKey == VK_UP, ( MsgInfo( "Up" ), .T. ),) }
Desculpe antonio, acredito que minha classe twbrowse não esta legal, usted poderia me indicar uma classe funcional para download?
Obrigado
La Clase TWBrowse está incluida en FWH y su código fuente está en fwh\source\classes\wbrowse.prg
grato