Ejemplo wvtext (wvtext.prg)

/*
 * $Id: wvtext.prg 14797 2010-06-17 13:37:58Z vszakats $
 */

//———————————————————————-//
//———————————————————————-//
//———————————————————————-//
//
//                   Harbour Extended Features Demo
//                                    .
//                 Pritpal Bedi <[email protected]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
  
LOCAL nHeight := 20
  
LOCAL nWidth  := Int( nHeight / 2 )
  
LOCAL cFont

   LOCAL nMSec

   Hb_GtInfo( HB_GTI_FONTNAME , cFont   )
  
Hb_GtInfo( HB_GTI_FONTWIDTH, nWidth  )
  
Hb_GtInfo( HB_GTI_FONTSIZE , nHeight )
  
SetCursor( SC_NONE )

   HB_GtInfo( HB_GTI_CLOSABLE, .F. )

   DispScreen()

   DO WHILE .T.

      nKey := Inkey( , INKEY_ALL + HB_INKEY_GTEVENT )

      if nKey == K_ESC
        
exit
     
endif

      IF nMSec != NIL .AND. hb_milliSeconds() > nMSec + 1500
        
DispOutAt( maxrow(), 0, Space( maxcol()+1 ), "N/G*" )
        
nMSec := NIL
     
ENDIF

      DO CASE
     
CASE nKey == K_ENTER
        
Alert( "<Enter> Pressed" )

      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 )

      CASE nKey == K_F4
        
lClose := Hb_GtInfo( HB_GTI_CLOSABLE )
        
hb_GtInfo( HB_GTI_CLOSABLE, !lClose )

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

      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 == HB_K_RESIZE
        
DispScreen()
        
DispOutAt( maxrow(), 33, "Resized      ", "B/G*" )
        
nMSec := hb_milliSeconds()

      CASE nKey == HB_K_GOTFOCUS
        
DispOutAt( maxrow(), 33, "We got focus ", "B/G*" )
        
nMSec := hb_milliSeconds()

      CASE nKey == HB_K_LOSTFOCUS
        
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 := 11, nCol := 28
  
LOCAL cColor := "N/W"
  
LOCAL nMaxCol := MaxCol() + 1
  
LOCAL l1,l2,l3,l4,l5

   DispBegin()

   SetColor( "N/W" )
  
CLS
  
DispOutAt( 0, 0, PadC( "Harbour GT – New Features", nMaxCol ), "N/GR*" )

   l1 := "______  __             ______________________                        "
  
l2 := "___  / / /_____ ___________ /___________  _________    __  ____/____/"
  
l3 := "__  /_/ /_  __ `/_  ___/_  __ \  __ \  / / /_  ___/    _  / __ __/   "
  
l4 := "_  __  / / /_/ /_  /   _  /_/ / /_/ / /_/ /_  /        / /_/ / _  /  "
  
l5 := "/_/ /_/  \__,_/ /_/    /_.___/\____/\__,_/ /_/         \____/  /_/   "

   // Contributed by Massimo Belgrano
  
DispOutAt( 2, 0, PadC( l1 ,nMaxCol ), "W+/W" )
  
DispOutAt( 3, 0, PadC( l2 ,nMaxCol ), "W+/W" )
  
DispOutAt( 4, 0, PadC( l3 ,nMaxCol ), "W+/W" )
  
DispOutAt( 5, 0, PadC( l4 ,nMaxCol ), "W+/W" )
  
DispOutAt( 6, 0, PadC( l5 ,nMaxCol ), "W+/W" )

   DispOutAt( ++nRow, 0, PadC( "< F2 MarkCopy    Toggle >", nMaxCol ), cColor )
  
DispOutAt( ++nRow, 0, PadC( "< F3 Resize      Toggle >", nMaxCol ), cColor )
  
DispOutAt( ++nRow, 0, PadC( "< F4 Closable    Toggle >", 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 >", nMaxCol ), cColor )
  
DispOutAt( ++nRow, 0, PadC( "< F10 Open New Window   >", 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 )

   STATIC s_nR := 198
  
STATIC s_nG := 198
  
STATIC s_nB := 198

   s_nR += iif( nMode == 0, 5, 5 )
  
s_nG += iif( nMode == 0, 5, 5 )
  
s_nB += iif( nMode == 0, 5, 5 )

   // Change "W" to slightly gray everytime you press F5
  
//
  
aPalette[ 8 ] := RGB( s_nR, s_nG, s_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()
  
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*’ }

   STATIC nBrowser := 0
  
STATIC nZx := 0
  
STATIC nZy := 0

   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_WINTITLE, ‘test.dbf    [‘ + iif( ( nBrowser % 2 ) != 0,;
                          ‘RESIZABLE_BY_ROWS’
, ‘RESIZABLE_BY_FONT’ ) + ‘]’ )

   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 ] )
  
Hb_GtInfo( HB_GTI_WINTITLE, cTitle )
  
Hb_GtInfo( HB_GTI_SETPOS_XY, nZx, nZy )

   cTitle := ‘New Window with ‘+ hb_ntos( MaxRow() ) +;
                          ‘ Rows and ‘
+ hb_ntos( MaxCol() ) + ‘ Columns’
  
DispOutAt( 0, 0, padc( cTitle, maxcol() + 1 ), ‘N/GR*’ )

   USE test 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 )
        
//
     
ELSE
        
IF nKey == HB_K_RESIZE
           
cTitle := ‘New Window with ‘+ltrim( str( MaxRow() ) )+;
                          ‘ Rows and ‘
+ltrim( str( MaxCol() ) )+‘ Columns’
           
DispOutAt( 0, 0, padc( cTitle, maxcol()+1 ), ‘N/GR*’ )

            oBrowse:nBottom := MaxRow()
           
oBrowse:nRight := MaxCol()
           
oBrowse:Configure()
           
oBrowse:RefreshAll()
        
ENDIF
     
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.

   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.

   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

26-06-2010 12-33-01

26-06-2010 12-33-21

26-06-2010 12-35-26

Ejemplo Tbrowse (tb1.prg)

/*
 * $Id: tb1.prg 14676 2010-06-03 16:23:36Z vszakats $
 */

/*
 
* Harbour Project source code:
 *    Demonstration/test code for TBrowse class
 *
 * Copyright 2009 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
 * www – http://harbour-project.org
 *
 */

#include "inkey.ch"
#include "button.ch"
#include "setcurs.ch"
#include "box.ch"

proc main()

   static s_nCount := 0
  
static s_nPos   := 1
  
static s_nSize  := 100

   local nTop, nLeft, nBottom, nRight
  
local cColor
  
local oBrw, oCol1, oCol2, oCol3, oCol4
  
local nKey, nCol

   nTop    := 2
  
nLeft   := 10
  
nBottom := 20
  
nRight  := 70
  
cColor  := "W+/R,G+/BR,RG+/B,BG+/G,N/GR,GR+/BG,B/GR*"

   set date format to "yyyy/mm/dd"

   // enable mouse events in CL53/Harbour
  
#ifdef _SET_EVENTMASK
     
set( _SET_EVENTMASK, INKEY_ALL )
     
mSetCursor( .t. )
  
#endif

   cls
  
dispBox( nTop, nLeft, nBottom, nRight, B_DOUBLE_SINGLE, cColor )
  
oBrw := tbrowseNew( nTop + 1, nLeft + 1, nBottom  1, nRight  1 )
  
dispOutAt( nTop + 3,    nLeft,  "Ã", cColor )
  
dispOutAt( nTop + 3,    nRight, "´", cColor )
  
dispOutAt( nBottom  2, nLeft,  "Ã", cColor )
  
dispOutAt( nBottom  2, nRight, "´", cColor )

   oBrw:colorSpec( cColor )
  
oBrw:headSep := "¿ ÚÄ"
  
oBrw:footSep := "Ù ÀÄ"
  
oBrw:colSep  := "³ ³"

   oBrw:SkipBlock     := { | n | hb_idleSleep( 0.2 ), ;
                          
n := iif( n < 0, max( n, 1  s_nPos ), ;
                                           
min( s_nSize  s_nPos, n ) ), ;
                          
s_nPos += n, n }
  
oBrw:GoTopBlock    := { || s_nPos := 1 }
  
oBrw:GoBottomBlock := { || s_nPos := s_nSize }

   oCol1 := tbColumnNew( "COL;1;", {|| s_nPos } )
  
oCol1:defColor := { 2, 1, 3, 4 }
  
oCol1:footing := "position"
  
oCol1:colorBlock := {|val| { val % 5 + 1, val % 3 + 2 } }

   oCol2 := tbColumnNew( "COL;2",  {|| s_nCount++ } )
  
oCol2:defColor := { 3, 4, 5, 6 }
  
oCol2:footing := "counter"
  
oCol2:headSep := "¿ ÚÄ´HIDEÃÄ"

   oCol3 := tbColumnNew( "COL 3",  {|| s_nPos % 3 == 0 } )
  
oCol3:defColor := { 5, 6, 2, 3 }
  
oCol3:footing := "logical"
  
oCol3:picture := "@YR [Y]"  // Clipper wrongly calculate the size here
  
oCol3:headSep := "· ÖÄ´HIDEÃÄ"
  
oCol3:footSep := "½ ÓÄ"
  
oCol3:colSep  := "º º"

   oCol4 := tbColumnNew( "   SHOW;   ALL",  {|| date()  s_nPos} )
  
oCol4:defColor := { 6, 3, 4, 2 }
  
oCol4:footing := "date"

   oBrw:addColumn( oCol1 )
  
oBrw:addColumn( oCol2 )
  
oBrw:addColumn( oCol3 )
  
oBrw:addColumn( oCol4 )

   // start at bottom
  
oBrw:goBottom()

   while .T.
     
while !oBrw:stabilize() .and. nextkey()==0
     
enddo
     
nKey := inkey( 0 )
     
if nKey == K_ESC
        
exit
     
elseif nKey == K_INS
        
oBrw:colorRect( { oBrw:rowPos, 1, oBrw:rowPos, 4 }, { 7, 6 } )
     
elseif nKey == K_DEL
        
oBrw:refreshCurrent()
     
elseif nKey >= ASC( "0" ) .AND. nKey <= ASC( "3" )
        
oBrw:freeze := nKey  ASC( "0" )
     
elseif nKey == K_LBUTTONDOWN .and. ;
            
oBrw:hitTest(mRow(),mCol()) == HTHEADSEP .and. ;
            
( ( nCol := oBrw:mColPos ) == 2 .or. nCol == 3 )
        
if nCol == 2
           
oCol2:width := 0
        
else
           
oCol3:width := 0
        
endif
        
oBrw:configure()
     
elseif nKey == K_LBUTTONDOWN .and. ;
            
oBrw:hitTest(mRow(),mCol()) == HTHEADING .and. ;
            
oBrw:mColPos == 4
        
oCol2:width := 10
        
oCol3:width := 7
        
oBrw:configure()
     
else
        
oBrw:applyKey( nKey )
     
endif
  
enddo

return

#ifndef __HARBOUR__
proc hb_idleSleep( n )
  
n += seconds()
  
while seconds() < n
  
enddo
return
#endif

06-06-2010 12-33-36

Ejemplo Versión (version.prg)

/*
   $Id: version.prg 14676 2010-06-03 16:23:36Z vszakats $

   Testing the VERSION function

   Harbour Project source code http://harbour-project.org/
   Donated to the public domain by David G. Holm <[email protected]>.
*/

Function Main()

   outstd( chr( 34 ) + version() + chr( 34 ) + hb_osnewline() )
  
outstd( chr( 34 ) + hb_compiler() + chr( 34 ) + hb_osnewline() )
  
outstd( chr( 34 ) + os() + chr( 34 ) + hb_osnewline() )

   Return nil

06-06-2010 12-18-44