fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
d89dd2ad8f6a54881dd2e5aa2ce5deef9dd63607
harbour-core/harbour/tests/wvtext.prg
Viktor Szakats 1ad759fbb5 2011-06-09 22:50 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) 
* src/rtl/gtwvt/gtwvt.h
  * src/rtl/gtwvt/gtwvt.c
  * tests/wvtext.prg
    + Massive GTWVT patch from Heinz V. Bergen. Thank you very much.
      Details:
      - fixed Alt-Enter for full screen, will no longer send the
        K_ENTER to the Input queue.
      - HB_K_RESIZE only sent if the Rows/Cols size actually changed.
      - Clicking Maximize (top right corner) button, will maximize window
        and change to Restore button, then clicking Restore button will
        restore the window to its previous size.
      - Dbl-clicking Title-Bar will maximize, then Dbl-Clicking Title
        bar again will restore.
      - Resizing window when in RESIZEMODE_FONT, will dynamically display
        the resulting size changes in real time.
      - All Maximize / Restore / Sizing works in RESIZEMODE_ROWS as would
        be expected.
      - Windows 7, dragging Window (Title-Bar) to top of screen will maximize,
        then dragging maximized window's Title bar down will Restore
        to previous size.
      - Windows 7, dragging Window (Title-Bar) left or right until mouse
        pointer hits the edge of the screen will size and dock to the left
        or right half of the screen, then dragging title bar away from docked
        position will restore the Window to its previous size.
      - Windows 7, resizing top or bottom until edge of screen hit
        (or dbl-clicking) will resize for maximum height. Then dragging
        title bar away will restore to previous size.
      - Before, depending on monitor's resolution, and when using
        Courier New or Terminal font, maximizing would fail due to Font
        metrics being incompatible with the Window's size or maybe due to
        math issues, I was able to resolve by slightly adjusting the Font's
        width or height down and then trying again until successful.
      - Pressing Alt-Enter (when enabled) for full screen mode and then
        pressing Alt-Enter again will restore Window to previous
        non-maximized size.
      - extended GT test app
    ; Please make test and report any experiences on devel list
2011-06-09 20:51:42 +00:00

617 lines
20 KiB
Plaintext
Raw Blame History

/*
* $Id$
*/
//----------------------------------------------------------------------//
//----------------------------------------------------------------------//
//----------------------------------------------------------------------//
//
// Harbour Extended Features Demo
// .
// Pritpal Bedi <pritpal@vouchcac.com>
//
//----------------------------------------------------------------------//
//----------------------------------------------------------------------//
//----------------------------------------------------------------------//
#include "hbgtinfo.ch"
#include "inkey.ch"
#include "setcurs.ch"
#define RGB( r, g, b ) ( r + ( g * 256 ) + ( b * 256 * 256 ) )
//----------------------------------------------------------------------//
STATIC s_nRows := 20
STATIC s_nCols := 60
STATIC s_nColorIndex := 1
//----------------------------------------------------------------------//
PROCEDURE Main()
LOCAL nKey, lMark, lResize, lClose, aKeys[ 50 ], nI, lAltEnter
LOCAL nHeight := 20
LOCAL nWidth := Int( nHeight / 2 )
LOCAL cFontName
LOCAL GetList := {}
LOCAL nModeCols, nModeRows, nWndHeight, nWndWidth, nMaxWHeight, nMaxWWidth, aWndSize := { 0, 0 }
LOCAL nMSec
AFill( aKeys, 0 )
hb_gtInfo( HB_GTI_FONTNAME , "Lucida Console" )
hb_gtInfo( HB_GTI_FONTWIDTH, nWidth )
hb_gtInfo( HB_GTI_FONTSIZE , nHeight )
hb_gtInfo( HB_GTI_WINTITLE , "GTWVT-Test (Resizable by Font)" )
hb_gtInfo( HB_GTI_ALTENTER, .T. ) // allow alt-enter for full screen
SetCursor( SC_NONE )
hb_gtInfo( HB_GTI_CLOSABLE, .F. )
DispScreen()
DO WHILE .T.
FOR nI := 1 TO Len( aKeys )
IF aKeys[ nI ] == 0 .OR. nI > MaxRow() - 1
EXIT
ENDIF
@ nI, MaxCol() - 5 SAY Str( aKeys[ nI ], 4, 0 )
NEXT
IF nMSec != NIL .AND. hb_milliSeconds() > nMSec + 2000
DispOutAt( MaxRow(), 0, Space( MaxCol() + 1 ), "N/G*" )
nMSec := NIL
ENDIF
nKey := Inkey( 0.1, 254 + HB_INKEY_GTEVENT )
IF nKey == 0
LOOP
ENDIF
AIns( aKeys, 1 )
aKeys[ 1 ] := nKey
FOR nI := 1 TO Len( aKeys )
IF aKeys[ nI ] == 0 .OR. nI > MaxRow() - 1
EXIT
ENDIF
@ nI, MaxCol() - 5 SAY Str( aKeys[ nI ], 4, 0 )
NEXT
IF nKey == K_ESC
EXIT
ENDIF
DO CASE
CASE nKey == K_ENTER
Alert( "<Enter> Pressed" )
CASE nKey == Asc( "0" ) // setmode
SetColor( "W+/B,GR+/N,W/B,B/B,G+/N" )
DO WHILE .T.
nModeCols := MaxCol() + 1
nModeRows := MaxRow() + 1
@ MaxRow() / 2 - 1, 0 SAY Space( MaxCol() )
@ MaxRow() / 2, 0 SAY Space( MaxCol() )
@ MaxRow() / 2 + 1, 0 SAY Space( MaxCol() )
@ MaxRow() / 2, 2 SAY "SetMode( 99 , 999 ) ESC-Cancels"
@ MaxRow() / 2, 11 GET nModeRows PICTURE "99" RANGE 10, 99
@ MaxRow() / 2, 16 GET nModeCols PICTURE "999" RANGE 20, 300
READ
IF LastKey() == K_ESC
EXIT
ENDIF
IF ! SetMode( nModeRows, nModeCols )
Alert( "SetMode() Failed!" )
ELSE
EXIT
ENDIF
ENDDO
DispScreen()
CASE nKey == Asc( "1" ) // "1" get/set Window-Height
nWndHeight := hb_gtInfo( HB_GTI_SCREENHEIGHT )
nMaxWHeight := hb_gtInfo( HB_GTI_DESKTOPHEIGHT )
SetColor( "W+/B,GR+/N,W/B,B/B,G+/N" )
@ MaxRow() / 2 - 1, 0 SAY Space( MaxCol() )
@ MaxRow() / 2, 0 SAY Space( MaxCol() )
@ MaxRow() / 2 + 1, 0 SAY Space( MaxCol() )
@ MaxRow() / 2, 2 SAY "Get/Set Window Height: 9999 (Max: " + hb_ntos( nMaxWHeight ) + ")"
@ MaxRow() / 2, 25 GET nWndHeight PICTURE "9999" RANGE 100, nMaxWHeight
READ
IF LastKey() != K_ESC
hb_gtInfo( HB_GTI_SCREENHEIGHT, nWndHeight )
ENDIF
DispScreen()
CASE nKey == Asc( "2" ) // get/set Window-WIDTH
nWndWIDTH := hb_gtInfo( HB_GTI_SCREENWIDTH )
nMaxWWIDTH := hb_gtInfo( HB_GTI_DESKTOPWIDTH )
SetColor( "W+/B,GR+/N,W/B,B/B,G+/N" )
@ MaxRow() / 2 - 1, 0 SAY Space( MaxCol() )
@ MaxRow() / 2, 0 SAY Space( MaxCol() )
@ MaxRow() / 2 + 1, 0 SAY Space( MaxCol() )
@ MaxRow() / 2, 2 SAY "Get/Set Window WIDTH: 9999 (Max: " + hb_ntos( nMaxWWIDTH ) + ")"
@ MaxRow() / 2, 24 GET nWndWIDTH PICTURE "9999" RANGE 100, nMaxWWIDTH
READ
IF LastKey() != K_ESC
hb_gtInfo( HB_GTI_SCREENWIDTH, nWndWIDTH )
ENDIF
DispScreen()
CASE nKey == Asc( "3" ) // get/set Window-Size
aWndSize := hb_gtInfo( HB_GTI_SCREENSIZE )
nMaxWWIDTH := hb_gtInfo( HB_GTI_DESKTOPWIDTH )
nMaxWHeight := hb_gtInfo( HB_GTI_DESKTOPHEIGHT )
SetColor( "W+/B,GR+/N,W/B,B/B,G+/N" )
@ MaxRow() / 2 - 1, 0 SAY Space( MaxCol() )
@ MaxRow() / 2, 0 SAY Space( MaxCol() )
@ MaxRow() / 2 + 1, 0 SAY Space( MaxCol() )
@ MaxRow() / 2, 2 SAY "Get/Set Window Size(WxH): 9999 x 9999 (Max: " + hb_ntos( nMaxWWIDTH ) + " x " + hb_ntos( nMaxWHeight ) + ")"
@ MaxRow() / 2, 28 GET aWndSize[ 1 ] PICTURE "9999" RANGE 100, nMaxWWIDTH
@ MaxRow() / 2, 35 GET aWndSize[ 2 ] PICTURE "9999" RANGE 100, nMaxWHeight
READ
IF LastKey() != K_ESC
hb_gtInfo( HB_GTI_SCREENSIZE, aWndSize )
ENDIF
DispScreen()
CASE nKey == Asc( "4" ) // set Window-Position by pixels
aWndSize := hb_gtInfo( HB_GTI_SETPOS_XY )
SetColor( "W+/B,GR+/N,W/B,B/B,G+/N" )
@ MaxRow() / 2 - 1, 0 SAY Space( MaxCol() )
@ MaxRow() / 2, 0 SAY Space( MaxCol() )
@ MaxRow() / 2 + 1, 0 SAY Space( MaxCol() )
@ MaxRow() / 2, 2 SAY "Get/Set Window Position in pixels(Left/Top): 9999 / 9999 "
@ MaxRow() / 2, 47 GET aWndSize[ 1 ] PICTURE "9999"
@ MaxRow() / 2, 54 GET aWndSize[ 2 ] PICTURE "9999"
READ
IF LastKey() != K_ESC
hb_gtInfo( HB_GTI_SETPOS_XY, aWndSize )
ENDIF
DispScreen()
CASE nKey == Asc( "5" ) // set Window-Position by row/col
aWndSize := hb_gtInfo( HB_GTI_SETPOS_ROWCOL )
SetColor( "W+/B,GR+/N,W/B,B/B,G+/N" )
@ MaxRow() / 2 - 1, 0 SAY Space( MaxCol() )
@ MaxRow() / 2, 0 SAY Space( MaxCol() )
@ MaxRow() / 2 + 1, 0 SAY Space( MaxCol() )
@ MaxRow() / 2, 2 SAY "Get/Set Window Position by Row/Col: 999 / 999 "
@ MaxRow() / 2, 38 GET aWndSize[ 1 ] PICTURE "999"
@ MaxRow() / 2, 44 GET aWndSize[ 2 ] PICTURE "999"
READ
IF LastKey() != K_ESC
hb_gtInfo( HB_GTI_SETPOS_ROWCOL, aWndSize[ 1 ], aWndSize[ 2 ] )
ENDIF
DispScreen()
CASE nKey == K_F1
Alert( "Additional Hot-Key Test Settings:;;" + ;
"0 - SetMode( nRows, nCols ) test ;" + ;
"1 - Get/Set HB_GTI_SCREENHEIGHT test ;" + ;
"2 - Get/Set HB_GTI_SCREENWIDTH test ;" + ;
"3 - Get/Set HB_GTI_SCREENSIZE test ;" + ;
"4 - Get/Set HB_GTI_SETPOS_XY test ;" + ;
"5 - Get/Set HB_GTI_SETPOS_ROWCOL test", , "W+/B" )
CASE nKey == K_F2
lMark := hb_gtInfo( HB_GTI_SELECTCOPY )
hb_gtInfo( HB_GTI_SELECTCOPY, ! lMark )
CASE nKey == K_F3
lResize := hb_gtInfo( HB_GTI_RESIZABLE )
hb_gtInfo( HB_GTI_RESIZABLE, ! lResize )
DispScreen()
CASE nKey == K_F4
lClose := hb_gtInfo( HB_GTI_CLOSABLE )
hb_gtInfo( HB_GTI_CLOSABLE, ! lClose )
DispScreen()
CASE nKey == K_F5
SetPalette( 1 )
CASE nKey == K_F6
SetPalette( 0 )
CASE nKey == K_F7
SetPaletteIndex()
CASE nKey == K_F8
Alert( "Menu text changed. Was: " + hb_gtInfo( HB_GTI_SELECTCOPY, Dtos(Date() ) + " " + Time() ) )
CASE nKey == K_F9
hb_gtInfo( HB_GTI_RESIZEMODE, iif( hb_gtInfo( HB_GTI_RESIZEMODE ) == HB_GTI_RESIZEMODE_ROWS, HB_GTI_RESIZEMODE_FONT, HB_GTI_RESIZEMODE_ROWS ) )
hb_gtInfo( HB_GTI_WINTITLE , "GTWVT-Test (Resizable by " + iif( hb_gtInfo( HB_GTI_RESIZEMODE ) == HB_GTI_RESIZEMODE_ROWS, "ROWS", "FONT" ) + ")" )
DispScreen()
CASE nKey == K_F10
IF hb_MTVM()
hb_threadStart( @thFunc() )
ELSE
Alert( "MT mode not available. Rebuild this program with -mt switch and try again." )
ENDIF
CASE nKey == K_F11
lAltEnter := hb_gtInfo( HB_GTI_ALTENTER )
hb_gtInfo( HB_GTI_ALTENTER, ! lAltEnter )
DispScreen()
CASE nKey == K_F12
cFontName := hb_gtInfo( HB_GTI_FONTNAME )
IF cFontName == "Lucida Console"
hb_gtInfo( HB_GTI_FONTNAME , "Courier New" )
ELSEIF cFontName == "Courier New"
hb_gtInfo( HB_GTI_FONTNAME , "Terminal" )
ELSEIF cFontName == "Terminal"
hb_gtInfo( HB_GTI_FONTNAME , "DejaVu Sans Mono" )
ELSE
hb_gtInfo( HB_GTI_FONTNAME , "Lucida Console" )
ENDIF
IF hb_gtInfo( HB_GTI_RESIZEMODE ) == HB_GTI_RESIZEMODE_ROWS
hb_gtInfo( HB_GTI_RESIZEMODE, HB_GTI_RESIZEMODE_FONT )
SetMode( MaxRow(), MaxCol() )
SetMode( MaxRow() + 2, MaxCol() + 2 )
hb_gtInfo( HB_GTI_RESIZEMODE, HB_GTI_RESIZEMODE_ROWS )
ELSE
SetMode( MaxRow(), MaxCol() )
SetMode( MaxRow() + 2, MaxCol() + 2 )
ENDIF
DispScreen()
DispOutAt( MaxRow(), 2, "< Font changed to " + hb_gtInfo( HB_GTI_FONTNAME ) + " >", "B/G*" )
nMSec := hb_milliSeconds()
CASE nKey == HB_K_RESIZE
DispScreen()
DispOutAt( MaxRow(), 33, "Resized ", "B/G*" )
nMSec := hb_milliSeconds()
CASE nKey == HB_K_GOTFOCUS
ChgPalette( .T. )
DispOutAt( MaxRow(), 33, "We got focus ", "B/G*" )
nMSec := hb_milliSeconds()
CASE nKey == HB_K_LOSTFOCUS
ChgPalette( .F. )
DispOutAt( MaxRow(), 33, "We lost focus", "B/G*" )
nMSec := hb_milliSeconds()
CASE nKey == HB_K_CLOSE
IF Alert( "Close Application", { "Yes", "No" } ) == 1
QUIT
ENDIF
ENDCASE
ENDDO
RETURN
//-------------------------------------------------------------------//
STATIC PROCEDURE DispScreen()
LOCAL nRow := 9
LOCAL cColor := "N/W"
LOCAL nMaxCol := MaxCol() + 1
DispBegin()
SetColor( "N/W" )
CLS
DispOutAt( 0, 0, PadC( "Harbour GT - New Features", nMaxCol ), "N/GR*" )
// Contributed by Massimo Belgrano
DispOutAt( 2, 0, PadC( "______ __ ______________________ ", nMaxCol ), "W+/W" )
DispOutAt( 3, 0, PadC( "___ / / /_____ ___________ /___________ _________ __ ____/____/", nMaxCol ), "W+/W" )
DispOutAt( 4, 0, PadC( "__ /_/ /_ __ `/_ ___/_ __ \ __ \ / / /_ ___/ _ / __ __/ ", nMaxCol ), "W+/W" )
DispOutAt( 5, 0, PadC( "_ __ / / /_/ /_ / _ /_/ / /_/ / /_/ /_ / / /_/ / _ / ", nMaxCol ), "W+/W" )
DispOutAt( 6, 0, PadC( "/_/ /_/ \__,_/ /_/ /_.___/\____/\__,_/ /_/ \____/ /_/ ", nMaxCol ), "W+/W" )
DispOutAt( 8, 0, PadC( "MODE: " + hb_ntos( MaxRow() + 1 ) + " Rows and " + hb_ntos( nMaxCol ) + " Columns", nMaxCol ), cColor )
DispOutAt( ++nRow, 0, PadC( "< F2 MarkCopy Toggle > ", nMaxCol ), cColor )
DispOutAt( ++nRow, 0, PadC( "< F3 Resizable Toggle > " + iif( hb_gtInfo( HB_GTI_RESIZABLE ), "ON ", "Off" ), nMaxCol ), cColor )
DispOutAt( ++nRow, 0, PadC( "< F4 Closable Toggle > " + iif( hb_gtInfo( HB_GTI_CLOSABLE ), "ON ", "Off" ), nMaxCol ), cColor )
DispOutAt( ++nRow, 0, PadC( "< F5 Palette L Repeat > ", nMaxCol ), cColor )
DispOutAt( ++nRow, 0, PadC( "< F6 Palette D Repeat > ", nMaxCol ), cColor )
DispOutAt( ++nRow, 0, PadC( "< F7 Palette By Index R > ", nMaxCol ), cColor )
DispOutAt( ++nRow, 0, PadC( "< F8 MarkCopy menu text > ", nMaxCol ), cColor )
DispOutAt( ++nRow, 0, PadC( "< Click Other Window > ", nMaxCol ), cColor )
DispOutAt( ++nRow, 0, PadC( "< Click X Button > ", nMaxCol ), cColor )
DispOutAt( ++nRow, 0, PadC( "< F9 Resize Mode Toggle > " + iif( hb_gtInfo( HB_GTI_RESIZEMODE ) == HB_GTI_RESIZEMODE_ROWS, "ROWS", "FONT" ), nMaxCol ), cColor )
DispOutAt( ++nRow, 0, PadC( "< F10 Open New Window > ", nMaxCol ), cColor )
DispOutAt( ++nRow, 0, PadC( "< F11 Alt-Enter Toggle > " + iif( hb_gtInfo( HB_GTI_ALTENTER ), "ON ", "Off" ), nMaxCol ), cColor )
DispOutAt( ++nRow, 0, PadC( "< F12 Change Font Test > " + hb_gtInfo( HB_GTI_FONTNAME ) + " " + hb_ntos( hb_gtInfo( HB_GTI_FONTWIDTH ) ) + "x" + hb_ntos( hb_gtInfo( HB_GTI_FONTSIZE ) ), nMaxCol ), cColor )
DispOutAt( MaxRow(), 0, Space( MaxCol() + 1 ), "N/G*" )
DispOutAt( 0, 0 , "TL", "N/GR*" )
DispOutAt( 0, MaxCol() - 1 , "TR", "N/GR*" )
DispOutAt( MaxRow(), 0 , "BL", "N/G*" )
DispOutAt( MaxRow(), MaxCol() - 1, "BR", "N/G*" )
DispEnd()
RETURN
//-------------------------------------------------------------------//
PROCEDURE HB_GTSYS()
REQUEST HB_GT_WVT_DEFAULT
REQUEST HB_GT_WIN
RETURN
//-------------------------------------------------------------------//
FUNCTION SetPalette( nMode )
LOCAL aPalette := hb_gtInfo( HB_GTI_PALETTE )
THREAD STATIC t_nR := 198
THREAD STATIC t_nG := 198
THREAD STATIC t_nB := 198
t_nR += iif( nMode == 0, - 5, 5 )
t_nG += iif( nMode == 0, - 5, 5 )
t_nB += iif( nMode == 0, - 5, 5 )
// Change "W" to slightly gray everytime you press F5
//
aPalette[ 8 ] := RGB( t_nR, t_nG, t_nB )
hb_gtInfo( HB_GTI_PALETTE, aPalette )
DispScreen()
RETURN NIL
//-------------------------------------------------------------------//
FUNCTION SetPaletteIndex()
hb_gtInfo( HB_GTI_PALETTE, 8, RGB( 120, 200, 240 ) )
DispScreen()
RETURN NIL
//-------------------------------------------------------------------//
PROCEDURE thFunc()
STATIC nBrowser := 0
STATIC nZx := 0
STATIC nZy := 0
LOCAL cTitle, oBrowse, lEnd, nKey, i, aStruct
LOCAL aColor := { "W+/N", "W+/B", "W+/G", "W+/BG", "W+/N*", "W+/RB", "N/W*", "N/GR*" }
nBrowser++
nZx += 20
nZy += 20
/* allocate own GT driver */
hb_gtReload( "WVT" )
hb_gtInfo( HB_GTI_PALETTE, 8, RGB( 120, 200, 240 ) )
IF ( nBrowser % 2 ) != 0
hb_gtInfo( HB_GTI_RESIZEMODE, HB_GTI_RESIZEMODE_ROWS )
ENDIF
hb_gtInfo( HB_GTI_FONTNAME , "Lucida Console" )
hb_gtInfo( HB_GTI_WINTITLE, "test.dbf [" + iif( ( nBrowser % 2 ) != 0, "RESIZABLE_BY_ROWS", "RESIZABLE_BY_FONT" ) + "]" )
hb_gtInfo( HB_GTI_ALTENTER, .T. ) //allow alt-enter for full screen
SetCursor( SC_NONE )
s_nColorIndex++
IF s_nColorIndex > Len( aColor )
s_nColorIndex := 1
ENDIF
s_nRows++
s_nCols += 2
SetMode( s_nRows, s_nCols )
SetColor( aColor[ s_nColorIndex ] )
cTitle := "New Window with " + hb_ntos( MaxRow() ) + ;
" Rows and " + hb_ntos( MaxCol() ) + " Columns"
dispOutAt( 0, 0, PadC( cTitle, MaxCol() + 1 ), "N/GR*" )
hb_gtInfo( HB_GTI_SETPOS_XY, nZx, nZy ) //this does not work until something is displayed
USE test NEW SHARED
aStruct := dbStruct()
oBrowse := TBrowse():New( 1, 0, MaxRow(), MaxCol() )
oBrowse:ColSep := " | "
oBrowse:HeadSep := "-+-"
oBrowse:GoTopBlock := { || dbGoTop() }
oBrowse:GoBottomBlock := { || dbGoBottom() }
oBrowse:SkipBlock := { | nSkip | dbSkipBlock( nSkip, oBrowse ) }
FOR i := 1 TO Len( aStruct )
oBrowse:AddColumn( TBColumnNew( aStruct[ i, 1 ], BlockField( i ) ) )
NEXT
oBrowse:configure()
lEnd := .F.
DO WHILE ! lEnd
oBrowse:ForceStable()
nKey := Inkey( 0, INKEY_ALL + HB_INKEY_GTEVENT )
IF ! BrwHandleKey( oBrowse, nKey, @lEnd )
DO CASE
CASE nKey == HB_K_GOTFOCUS
ChgPalette( .T. )
CASE nKey == HB_K_LOSTFOCUS
ChgPalette( .F. )
CASE nKey == HB_K_RESIZE
cTitle := "New Window with " + hb_ntos( MaxRow() ) + ;
" Rows and " + hb_ntos( MaxCol() ) + " Columns"
dispOutAt( 0, 0, PadC( cTitle, MaxCol() + 1 ), "N/GR*" )
oBrowse:nBottom := MaxRow()
oBrowse:nRight := MaxCol()
oBrowse:Configure()
oBrowse:RefreshAll()
ENDCASE
ENDIF
ENDDO
dbCloseArea()
RETURN
//-------------------------------------------------------------------//
STATIC FUNCTION DbSkipBlock( n, oTbr )
LOCAL nSkipped := 0
IF n == 0
dbSkip( 0 )
ELSEIF n > 0
DO WHILE nSkipped != n .AND. TBNext( oTbr )
nSkipped++
ENDDO
ELSE
DO WHILE nSkipped != n .AND. TBPrev( oTbr )
nSkipped--
ENDDO
ENDIF
RETURN nSkipped
//-------------------------------------------------------------------//
STATIC FUNCTION TBNext( oTbr )
LOCAL nSaveRecNum := RecNo()
LOCAL lMoved := .T.
HB_SYMBOL_UNUSED( oTbr )
IF Eof()
lMoved := .F.
ELSE
dbSkip( 1 )
IF Eof()
lMoved := .F.
dbGoto( nSaveRecNum )
ENDIF
ENDIF
RETURN lMoved
//-------------------------------------------------------------------//
STATIC FUNCTION TBPrev( oTbr )
LOCAL nSaveRecNum := RecNo()
LOCAL lMoved := .T.
HB_SYMBOL_UNUSED( oTbr )
dbSkip( - 1 )
IF Bof()
dbGoto( nSaveRecNum )
lMoved := .F.
ENDIF
RETURN lMoved
//-------------------------------------------------------------------//
STATIC FUNCTION BlockField( i )
RETURN { || FieldGet( i ) }
//-------------------------------------------------------------------//
STATIC FUNCTION BrwHandleKey( oBrowse, nKey, lEnd )
LOCAL lRet := .T.
DO CASE
CASE nKey == K_ESC ; lEnd := .T.
// CASE nKey == K_ENTER ; lEnd := .T.
CASE nKey == K_DOWN ; oBrowse:Down()
CASE nKey == K_UP ; oBrowse:Up()
CASE nKey == K_LEFT ; oBrowse:Left()
CASE nKey == K_RIGHT ; oBrowse:Right()
CASE nKey == K_PGDN ; oBrowse:pageDown()
CASE nKey == K_PGUP ; oBrowse:pageUp()
CASE nKey == K_CTRL_PGUP ; oBrowse:goTop()
CASE nKey == K_CTRL_PGDN ; oBrowse:goBottom()
CASE nKey == K_HOME ; oBrowse:home()
CASE nKey == K_END ; oBrowse:end()
CASE nKey == K_CTRL_LEFT ; oBrowse:panLeft()
CASE nKey == K_CTRL_RIGHT ; oBrowse:panRight()
CASE nKey == K_CTRL_HOME ; oBrowse:panHome()
CASE nKey == K_CTRL_END ; oBrowse:panEnd()
CASE nKey == K_MWBACKWARD ; oBrowse:down()
CASE nKey == K_MWFORWARD ; oBrowse:up()
OTHERWISE ; lRet := .F.
ENDCASE
RETURN lRet
//-------------------------------------------------------------------//
FUNCTION ChgPalette( lFocus )
LOCAL aPalette := hb_gtInfo( HB_GTI_PALETTE )
LOCAL cSaveScreen := SaveScreen( 0, 0, MaxRow(), MaxCol() )
LOCAL nR, nG, nB, nColor, nI, nDimFactor := 1.5
THREAD STATIC t_aSavePalette
IF t_aSavePalette == NIL
t_aSavePalette := AClone( aPalette )
ENDIF
IF lFocus
aPalette := t_aSavePalette
ELSE
FOR nI := 2 TO Len( aPalette )
nColor := aPalette[ nI ]
IF nColor >= 65536
nB := Int( nColor / 65536 )
nColor -= nB * 65536
nB := Int( nB / nDimFactor )
ELSE
nB := 0
ENDIF
IF nColor >= 256
nG := Int( nColor / 256 )
nColor -= nG * 256
nG := Int( nG / nDimFactor )
ELSE
nG := 0
ENDIF
IF nColor > 0
nR := Int( nColor / nDimFactor )
ELSE
nR := 0
ENDIF
aPalette[ nI ] := RGB( nR, nG, nB )
NEXT
ENDIF
hb_gtInfo( HB_GTI_PALETTE, aPalette )
RestScreen( 0, 0, MaxRow(), MaxCol(), cSaveScreen )
RETURN NIL
Reference in New Issue View Git Blame Copy Permalink