Files
harbour-core/harbour/tests/scroll.prg
Viktor Szakats 31a85b650e 2013-02-28 17:19 UTC+0100 Viktor Szakats (harbour syenar.net)
* utils/hbmk2/hbmk2.*.po
  * utils/hbmk2/hbmk2.prg
    % minor optimization to recent patch
    + cleanups in some help items
    + '-?' and '-h' options are now accepted as '-help'
    + '-??' and '-hh' options are now accepted as '-longhelp'
    - deleted '-license' option, it's now part of '-longhelp'
    ! hbshell_gtSelect() parameter fixed to be case insentitive
      in an internal check

  + tests/clipper.ch
    + added header file that translates certain Harbour
      specific functions to ones understood by Clipper.
      Useful to compile lightly Harbour specific code
      in Clipper (or other Clipper compatible language),
      for comparison.

  * tests/*.prg
  - tests/exthrb.prg
  + tests/hrbext.prg
  * website/samples/*.prg.html
    ! various cleanups, minor fixes, formatting
    + #included "clipper.ch" to enable running what's
      possible to run with Clipper

  * src/rtl/gtwin/gtwin.c
  * src/rtl/gtwvt/gtwvt.c
    ! return string type for hb_gtInfo( HB_GTI_FONTSEL )
      in sync with GTXWC

  * contrib/xhb/xhbfunc.c
  * include/hbdefs.h
    * HB_FUNC_EXEC() macro value to not end with ';',
      now it should be added on usage (almost all usages
      were such already). To be code formatter friendly.

  * contrib/xhb/xhb.hbp
  + contrib/xhb/xhbdepr.prg
    + added compatiblity stubs for functions deprecated from
      Harbour core, but still available in xHarbour. (xHarbour
      has yet to deprecate anything)
      So here we can gather stuff that's deprecated from Harbour
      core (except internal functions - most of them named '__*' -,
      and the "evil" ones)
    ; NOTE: Runtime efficiency is not a goal with these stubs,
            only "cheap" long term maintainability.

  - contrib/hbblat/tests/blattest.prg
  + contrib/hbblat/tests/test.prg
  * extras/guestbk/guestbk.hbp
  - extras/guestbk/testcgi.prg
  + extras/guestbk/cgi.prg
    * renames

  * src/vm/dynsym.c
  * contrib/hbfbird/tests/testapi.c
  * contrib/xhb/thtm.prg
    * minor
2013-02-28 16:25:51 +00:00

74 lines
1.9 KiB
Plaintext

/*
* $Id$
*/
// Testing Harbour screen scrolling (requires the GT API)
/* Harbour Project source code
http://harbour-project.org/
Donated to the public domain on 2001-03-08 by David G. Holm <dholm@jsd-llc.com>
*/
#include "box.ch"
PROCEDURE Main()
LOCAL ct
SetPos( MaxRow(), 0 )
DispBegin()
? "If you have the GT API linked in, the screen will be blanked, a text block"
? "will be drawn in the upper-left hand corner of the screen, and then the inside"
? "of the text block will be scrolled around. Otherwise, you will see the screen"
? "scroll, the text block will be drawn starting from the bottom right and scroll"
? "up, but there will be no scrolling inside the text block."
?
?
DispEnd()
Pause()
SET COLOR TO "GR+/RB"
CLS
@ 0, 0, 14, 45 BOX HB_B_SINGLE_UNI
@ 0, 0 SAY "01234567890123456789012345678901"
@ 1, 0 SAY "01234567890123456789012345678901"
@ 2, 0 SAY "01234567890123456789012345678901"
@ 3, 0 SAY "01234 78901"
@ 4, 0 SAY "01234 This is a test. 78901"
@ 5, 0 SAY "01234 This is only a test. 78901"
@ 6, 0 SAY "01234 Had this been a real 78901"
@ 7, 0 SAY "01234 emergency, you would 78901"
@ 8, 0 SAY "01234 be dead now. 78901"
@ 9, 0 SAY "01234 78901"
@ 10, 0 SAY "01234567890123456789012345678901"
@ 11, 0 SAY "01234567890123456789012345678901"
@ 12, 0 SAY "01234567890123456789012345678901"
@ 13, 0 SAY "0 1 2 3 "
Pause()
// save/restore test
cT := SaveScreen( 0, 0, 13, 31 )
RestScreen( 10, 40, 23, 71, cT )
pause()
Scroll( 1, 1, 11, 30, -2, -5 )
pause()
Scroll( 1, 1, 11, 30, 2, 5 )
pause()
Scroll( 1, 1, 11, 30, -5, 2 )
pause()
Scroll( 1, 1, 11, 30, 7, -12 )
pause()
SET COLOR TO "W+/R"
Scroll( 1, 1, 11, 30, 0, 0 )
pause()
RETURN
FUNCTION pause()
SetPos( MaxRow() - 2, 0 )
__Accept( "pause: " )
RETURN NIL