harbour-core/harbour/examples/gtwvw/tests/prog0.prg

/*
 * $Id$
 */

/*
   Copyright 2004 Budyanto Dj. <budyanto@centrin.net.id>

   This is a simple Clipper program runs simple GET and BROWSE dialogs
   each on a pseudo-window with brief help message on the bottom of
   the screen.

   Note that this Clipper program uses ZNEWWINDOW() and ZREVWINDOW() to
   open and close every pseudo-windows respectively.

   Compiling and linking in Clipper:
     clipper prog0 -m -n -w
     blinker file prog0
*/


#include "common.ch"
#include "inkey.ch"
#include "setcurs.ch"

static s_zwin := {}
static s_cStdColor := "N/W,N/GR*,,,N/W*"

proc main
local i,j
   SET SCOREBOARD OFF
   SetColor( s_cStdColor )
   setcursor(SC_NONE)
   CLS
   @ 0,0 say padc("This is the Main Window", maxcol()+1)

   * screen background
   DISPBEGIN()
   for i := 1 to maxrow()-1
      for j := 0 to maxcol()
         devpos(i,j)
         devout("±")
      next
   next
   DISPEND()

   lboxmessage("Welcome to our test program." + chr(13)+chr(10) +;
               "This program will show typical GET and BROWSE dialogs " +;
               "with brief help on the bottom of the screen.")
   xGet1()
   xBrowse1()
   lboxmessage("That's all folks")

   * restore state
   setcursor(SC_NORMAL)
return //main

procedure xGet1()
local nWin
local cName := padr("Name",20)
local cAddr := padr("Address",25)
local cPhone:= padr("Phone",15)
local cFax  := padr("Fax",15)
local lDone := .f.
local getlist := {}
local oldCurs := setcursor(SC_NORMAL)

   nWin := znewwindow("ÚÄ¿³ÙÄÀ³",10,20,22,59,"Some Window")

   //@ 21,21 say "Inside the window" color "R/W"
   //@ 23,0  say "Outside the window" color "R/W"

   do while !lDone
      @ 12,22 say "Name    : " get cName  pict "@!K" when lMessage("Please enter your name")
      @ 14,22 say "Address : " get cAddr  pict "@!K" when lMessage("Please enter your address")
      @ 16,22 say "Phone   : " get cPhone pict "@K"  when lMessage("Please enter your phone number")
      @ 18,22 say "Fax     : " get cFax   pict "@K"  when lMessage("Please enter your fax number")
      read

      lMessage("")
      lDone := lyesno("Done?")
   enddo

   zrevwindow()

   setcursor(oldCurs)
return //xGet1()

/* the following is adapted from WVTGUI.PRG by Pritpal Bedi
   for illustration purposes only */
FUNCTION xBrowse1()
   LOCAL nKey, bBlock, oBrowse , i
   LOCAL lEnd    := .f.
   LOCAL info_   := {}
   LOCAL nTop    :=  6
   LOCAL nLeft   :=  3
   LOCAL nBottom := maxrow() - 2
   LOCAL nRight  := maxcol() - 3
   LOCAL nCursor := setCursor( 0 )
   LOCAL nWin

   USE '..\..\..\tests\TEST' NEW
   if NetErr()
      return nil
   endif
   info_:= DbStruct()

   SetColor( 'N/W*,N/GR*,,,N/W* ' )
   oBrowse := TBrowseNew( nTop + 1, nLeft + 1, nBottom - 1, nRight - 1 )

   oBrowse:ColSep        = chr(179) //'|'
   oBrowse:HeadSep       = chr(205) //'_'
   oBrowse:GoTopBlock    = { || dbGoTop() }
   oBrowse:GoBottomBlock = { || dbGoBottom() }
   oBrowse:SkipBlock     = { | nSkip | dbSkipBlock( nSkip,oBrowse ) }

   for i := 1 to len( info_ )
      bBlock := VouBlockField( i )
      oBrowse:AddColumn( TBColumnNew( info_[ i,1 ], bBlock ) )
   next

   oBrowse:configure()

   nWin := znewwindow("ÚÄ¿³ÙÄÀ³",nTop,nLeft,nBottom,nRight, "test.dbf")

   While !lEnd
      oBrowse:ForceStable()

      lMessage("Record #" + alltrim(str(recno())) )

      nKey = InKey( 0 )

      do case
      case nKey == K_ESC .or. nKey == K_ENTER
         lEnd := lYesNo("Done?")
      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()
      endcase
   end

   lMessage("")

   zrevwindow()

   * restore state
   SetCursor( nCursor )

   DBCloseArea()
RETURN nil
//-------------------------------------------------------------------//
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 VouBlockField( i )
RETURN  {|| fieldget( i ) }


// supporting functions ***************************

function lMessage(cMsg)
* displays a message on maxrow() and returns .t.
local cOldColor := setcolor(s_cStdColor)
  @ maxrow(), 0 say padc(cMsg, maxcol()+1)
  setcolor(cOldColor)
return .t.

function lYesNo(cMsg)
* display cmsg with Yes/No option, returns .t. if Yes selected
local nTopLine, ;
      nLeft := 5, ;
      nBotLine := maxrow()-2,;
      nRight := maxcol()-5
local nChoice, nWidth, nWinNum
local oldCurs := setcursor(SC_NONE)
local oldColor := setcolor(s_cStdColor)

   default cMsg to "Please Confirm"

   cmsg := " " + alltrim(cmsg) + " "
   nWidth := max(len(cmsg), len("Yes"))
   nTopLine := nBotLine-2-1

   nLeft := max(nLeft, ((nRight+nLeft)*.5)-(nWidth*.5)-1)
   nRight := nLeft + nWidth + 1

   * open window
   nWinNum := znewwindow("ÚÄ¿³ÙÄÀ³", nTopLine, nLeft, nBotLine, nRight, cMsg)

   @ nTopLine+1, nLeft+1 PROMPT padr("Yes", nWidth)
   @ nTopLine+2, nLeft+1 PROMPT padr("No", nWidth)
   MENU TO nChoice

   * close window
   zrevwindow()

   setcursor(oldCurs)
   setcolor(oldColor)
return (nChoice==1)

function lBoxMessage(cMsg, cTitle)
local nTopLine, ;
      nLeft := 5, ;
      nBotLine := maxrow()-2,;
      nRight := maxcol()-5
local nwidth, nmaxwidth, i, nNumLines, cAline, nWinNum
local oldCurs := setcursor(SC_NONE)
local oldColor := setcolor(s_cStdColor)

   default cTitle to "Info"

   cmsg := alltrim(cmsg)
   nNumLines := MLCOUNT(cmsg,(nright-nleft)-1)
   nWidth := iif(nNumLines<2, len(cmsg), nRight-nLeft-1)
   nTopLine := nBotLine-nNumLines-1
   if nTopLine < 0            //too many lines to display
      nNumLines += nTopLine
      nTopLine := 0
   endif

   nMaxWidth := 0
   for i := 1 to nNumLines
      nMaxWidth := MAX(nMaxWidth, len(trim(memoline(cmsg,nwidth,i))))
   next

   nLeft := max(nLeft, INT( ((nRight+nLeft)/2)-(nMaxWidth/2)-1 ) )
   nRight := nLeft + nMaxWidth + 1

   * open window
   nWinNum := znewwindow("ÚÄ¿³ÙÄÀ³", nTopLine, nLeft, nBotLine, nRight, cTitle)
   DISPBEGIN()
   for i := 1 to nNumLines
     cAline := MEMOLINE(cMsg, nWidth, i)
     devpos(nTopLine+i, nLeft+1)
     devout(padc(alltrim(cAline), nMaxWidth))
   next
   DISPEND()

   inkey(0)

   * close window
   zrevwindow()

   setcursor(oldCurs)
   setcolor(oldColor)
return .t.

FUNCTION ZNEWWINDOW(wtype,r1,c1,r2,c2,ctitle, ccolor)
* Draw a new window on screen and register it in window list
* wtype       : Window border type, eg. "ÚÄ¿³ÙÄÀ³"
* r1,c1,r2,c2 : coordinates
* Return      : Numeric id of the new window
  local i:=len(s_zwin)
  local cScreen := savescreen(r1,c1,r2,c2)
  local cOldColor := SETCOLOR()
  local nrow := row(), ncol := col()

  default ctitle to ""
  default ccolor to s_cStdColor
  setcolor(ccolor)

  AADD(s_zwin,{i+1, r1, c1, r2, c2, cScreen, ctitle, nrow, ncol, coldcolor})

  SETCOLOR(ccolor)

  scroll(r1, c1, r2, c2)

  * GTWVW doesn't need box or textual title
  DISPBOX(r1,c1,r2,c2,wtype)
  if !empty(ctitle)
     cTitle := " " + alltrim(ctitle) + " "
     DevPos( r1, nCeiling( (c2+c1-len(cTitle))/2 ) )
     DevOut( cTitle )
  endif

  SETCOLOR(cOldColor)
RETURN(i+1)

FUNCTION ZREVWINDOW()
* Closes the last window and remove it from window list
  local i := len(s_zwin)

  if i == 0
     * no window to close
     return NIL
  endif

  * restore states
  restscreen(s_zwin[i][2], s_zwin[i][3], s_zwin[i][4], s_zwin[i][5], s_zwin[i][6])
  setpos(s_zwin[i][8], s_zwin[i][9])
  setcolor(s_zwin[i][10])

  * remove window from list
  adel(s_zwin, i)
  asize(s_zwin, len(s_zwin)-1)
RETURN(NIL)

function nCeiling(nNumber)
local nTemp
   nTemp := nNumber - INT(nNumber)  //right of dec point
   if nTemp>0
      nNumber := INT(nNumber) + 1
   else
      nNumber := INT(nNumber)
   endif
return nNumber