fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2011-03-30 15:50 UTC-0800 Pritpal Bedi (bedipritpal@hotmail.com)

Browse Source 
* contrib/gtwvg/tests/demowvg.prg
  * contrib/gtwvg/tests/wvgmodal.prg
  * contrib/gtwvg/tests/wvgtbrowser.prg
  * contrib/gtwvg/tests/wvgutilities.prg
    ! Fixed: many artifacts which got broken with GT changes
      in a couple of years.
    + Added: a menu option which to execute a modal Harbour Gt 
      window on top of a GUI window.

  + contrib/gtwvg/tests/demowvg1.prg
    + Added: a highly simplified demo for beginners to understand 
      the underlying concepts how GUI controls can be exploited 
      with CUI output. Press F2 which navigaing the GETS.
      This demo used GTWVG's inbuilt GUI controls handelling 
      mechanism instead of devising one's own. 
      This mechanism was introduced in GTWVG mush later 
      that demowvg.prg was written. In future I will try to 
      rewrite the demowvg.prg with in-built protocol.
This commit is contained in:
Pritpal Bedi
2011-03-30 22:59:07 +00:00
parent 237e269ca8
commit 593f73fae1
6 changed files with 299 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
harbour/ChangeLog
View File

@@ -16,6 +16,26 @@
The license applies to all entries newer than 2009-04-28.
*/
2011-03-30 15:50 UTC-0800 Pritpal Bedi (bedipritpal@hotmail.com)
* contrib/gtwvg/tests/demowvg.prg
* contrib/gtwvg/tests/wvgmodal.prg
* contrib/gtwvg/tests/wvgtbrowser.prg
* contrib/gtwvg/tests/wvgutilities.prg
! Fixed: many artifacts which got broken with GT changes
in a couple of years.
+ Added: a menu option which to execute a modal Harbour Gt
window on top of a GUI window.
+ contrib/gtwvg/tests/demowvg1.prg
+ Added: a highly simplified demo for beginners to understand
the underlying concepts how GUI controls can be exploited
with CUI output. Press F2 which navigaing the GETS.
This demo used GTWVG's inbuilt GUI controls handelling
mechanism instead of devising one's own.
This mechanism was introduced in GTWVG mush later
that demowvg.prg was written. In future I will try to
rewrite the demowvg.prg with in-built protocol.
2011-03-30 14:45 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
* utils/hbmk2/hbmk2.prg
+ Continue if there were no input files specified. This

30
harbour/contrib/gtwvg/tests/demowvg.prg
View File

@@ -74,13 +74,13 @@ EXIT PROCEDURE CleanHandles()
FOR EACH obj IN SetFonts()
WVG_DeleteObject( obj )
obj := NIL
NEXT
NEXT
FOR EACH obj IN SetIcons()
WVG_DeleteObject( obj )
obj := NIL
NEXT
RETURN
NEXT
RETURN
//-------------------------------------------------------------------//
@@ -104,10 +104,10 @@ PROCEDURE Main()
LOCAL nBtnRow := nMaxRows - 1
LOCAL cLabel := "(x)Harbour simulated GUI."
LOCAL aObjects := WvtSetObjects( {} )
SET DATE BRITISH
SET( _SET_EVENTMASK, INKEY_ALL )
SET( _SET_EVENTMASK, INKEY_ALL + HB_INKEY_GTEVENT )
Wvt_SetGui( .t. )
WvtSetKeys( .t. )
@@ -259,7 +259,7 @@ Function HB_GTSYS()
REQUEST HB_GT_WVT
REQUEST HB_GT_WGU
Return NIL
//------------------------------------------------------------------//
PROCEDURE WvtConsoleGets( nMode )
@@ -275,7 +275,7 @@ PROCEDURE WvtConsoleGets( nMode )
ENDIF
RETURN
//----------------------------------------------------------------------//
PROCEDURE WvtNextGetsConsole()
@@ -322,7 +322,7 @@ PROCEDURE WvtNextGets()
ENDIF
RETURN
//----------------------------------------------------------------------//
PROCEDURE WvtNextGets_X()
@@ -402,7 +402,7 @@ PROCEDURE WvtNextGets_X()
Wvt_RestScreen( wvtScr )
SetPos( nRow, nCol )
RETURN
//-------------------------------------------------------------------//
FUNCTION WvtPartialScreen()
@@ -445,7 +445,7 @@ FUNCTION WvtPartialScreen()
Wvt_SetPopupMenu( hPopup )
RETURN NIL
//-------------------------------------------------------------------//
function WvtLines()
@@ -506,7 +506,7 @@ function WvtLines()
RestScreen( 0,0,maxrow(),maxcol(), scr )
RETURN NIL
//-------------------------------------------------------------------//
FUNCTION CreateMainMenu()
@@ -538,6 +538,8 @@ FUNCTION CreateMainMenu()
oMenu:AddItem( "Google Maps" , {|| WvtConsoleGets( 1 ) } )
oMenu:AddItem( "-")
oMenu:AddItem( "Wvg Console with GCUI" , {|| ExecGCUI() } )
oMenu:AddItem( "-")
oMenu:AddItem( "Modal Window" , {|| DoModalWindow() } )
g_oMenuBar:addItem( "",oMenu )
oMenu := wvtMenu():new():create()
@@ -588,7 +590,7 @@ FUNCTION CreateMainMenu()
#endif
RETURN g_oMenuBar
//-------------------------------------------------------------------//
STATIC FUNCTION ActivateMenu( oMenu )
@@ -607,7 +609,7 @@ STATIC FUNCTION ActivateMenu( oMenu )
ENDIF
RETURN NIL
//-------------------------------------------------------------------//
STATIC FUNCTION GoogleMap()
@@ -649,5 +651,5 @@ STATIC FUNCTION GoogleMap()
ENDDO
RETURN NIL
//----------------------------------------------------------------------//

215
harbour/contrib/gtwvg/tests/demowvg1.prg Normal file
View File

@@ -0,0 +1,215 @@
/*
* $Id$
*/
/*----------------------------------------------------------------------*/
//
// GTWVT Console GUI Interface
//
// Pritpal Bedi <bedipritpal@hotmail.com>
//
/*----------------------------------------------------------------------*/
#include "inkey.ch"
#include "common.ch"
#include "wvtwin.ch"
#include "hbgtinfo.ch"
#include "hbgtwvg.ch"
#include "wvgparts.ch"
/*----------------------------------------------------------------------*/
#define IMAGE_VOUCH hb_dirBase() + "vouch1.bmp"
#define IMAGE_BROWSE hb_dirBase() + "v_browse.ico"
#define IMAGE_VR hb_dirBase() + "vr_1.ico"
#define IMAGE_NOTES hb_dirBase() + "v_notes.ico"
#define IMAGE_TOOLS hb_dirBase() + "v_tools.ico"
#define IMAGE_HELP hb_dirBase() + "v_notes.ico"
/*----------------------------------------------------------------------*/
MEMVAR GetList
/*----------------------------------------------------------------------*/
FUNCTION Main()
LOCAL aPaint
SET DATE BRITISH
SET( _SET_EVENTMASK, INKEY_ALL + HB_INKEY_GTEVENT )
Wvt_SetGui( .t. )
Wvt_SetFont( "Courier New", 18, 0, 0 )
Wvt_SetMouseMove( .t. )
SetColor( "N/W" )
CLS
Wvt_ShowWindow( SW_RESTORE )
Wvt_SetTitle( "Harbour's GTWVG Demo ( Simplified )" )
Wvt_SetIcon( hb_dirBase() + "vr_1.ico" )
SetGT( 1, hb_gtSelect() )
aPaint := {}
aAdd( aPaint, { "Label" , {|| Wvt_DrawLabel( 1, 40, "Harbour Console GUI Demo", 6, , rgb( 255,255,255 ), rgb( 198,198,198 ), "Arial", 26, , , , , .t., .t. ) } , { WVT_BLOCK_LABEL, 1, 10, 3, 50 } } )
aAdd( aPaint, { "Box_1" , {|| Wvt_DrawBoxRaised( 4, 4, 20, 75 ) } , { WVT_BLOCK_BOX , 4, 4, 20, 75 } } )
aAdd( aPaint, { "Box_2" , {|| Wvt_DrawBoxRecessed( 7, 61, 13, 70 ) } , { WVT_BLOCK_BOX , 7, 61, 13, 70 } } )
aAdd( aPaint, { "Box_3" , {|| Wvt_DrawBoxGroup( 15, 59, 18, 72 ) } , { WVT_BLOCK_BOX , 15, 59, 18, 72 } } )
aAdd( aPaint, { "Box_4" , {|| Wvt_DrawBoxGroup( 5, 6, 19, 44 ) } , { WVT_BLOCK_BOX , 5, 6, 19, 44 } } )
aAdd( aPaint, { "Image" , {|| Wvt_DrawImage( 8,62,12,69, IMAGE_VOUCH ) } , { WVT_BLOCK_IMAGE, 8, 62, 12, 69 } } )
aAdd( aPaint, { "Box_5" , {|| Wvt_DrawBoxRecessed( 7, 48, 13, 55 ) } , { WVT_BLOCK_BOX , 7, 48, 13, 55 } } )
aAdd( aPaint, { "Line_1", {|| Wvt_DrawLine( maxrow()-2, 0, maxrow()-2, maxcol(), WVT_LINE_HORZ, WVT_LINE_RECESSED, WVT_LINE_BOTTOM ) } , NIL } )
aAdd( aPaint, { "Gets" , {|| aEval( GetList, {|oGet| Wvt_DrawBoxGet( oGet:Row, oGet:Col, Len( Transform( oGet:VarGet(), oGet:Picture ) ) ) } ) }, NIL } )
ExecForm( aPaint )
RETURN NIL
/*----------------------------------------------------------------------*/
/* This function must be linked with the application */
FUNCTION Wvt_Paint()
WvtPaintObjects()
RETURN NIL
/*----------------------------------------------------------------------*/
STATIC FUNCTION ExecForm( aPaint )
LOCAL cColor := SetColor()
LOCAL aPnt
LOCAL dDate := date()
LOCAL cName := Pad( "Pritpal Bedi", 35 )
LOCAL cAdd1 := Pad( "60, New Professor Colony", 35 )
LOCAL cAdd2 := Pad( "Ludhiana, INDIA", 35 )
LOCAL cAdd3 := Pad( "http://hbide.vouch.info", 35 )
LOCAL nSlry := 20000
LOCAL nColGet := 8
aPnt := WvtSetPaint( aPaint )
SetColor( "N/W" )
CLS
SetColor( "N/W,N/GR*,,,N/W*" )
SetKey( K_F2, {|| DoModalDialog() } )
@ 6, nColGet SAY "< Date >"
@ 9, nColGet SAY "<" + PadC( "Name" , 33 ) + ">"
@ 12, nColGet SAY "<" + PadC( "Address", 33 ) + ">"
@ 16, 61 SAY "< Salary >"
@ 7, nColGet GET dDate WHEN DispStatusMsg( "Date must be Valid" )
@ 10, nColGet GET cName WHEN DispStatusMsg( "Must be one of the list!" ) VALID ( MyChoice() < 7 )
@ 13, nColGet GET cAdd1 WHEN DispStatusMsg( "Press F2 to get modal window" )
@ 15, nColGet GET cAdd2 WHEN DispStatusMsg( "Press F2 to activate modal window" )
@ 17, nColGet GET cAdd3 WHEN DispStatusMsg( "Press F2 to bring in front a modal window" )
@ 17, 61 GET nSlry PICTURE "@Z 9999999.99" WHEN ClearStatusMsg()
READ
SetColor( cColor )
WvtSetPaint( aPnt )
RETURN NIL
/*----------------------------------------------------------------------*/
FUNCTION HB_GTSYS()
REQUEST HB_GT_WVG_DEFAULT
REQUEST HB_GT_WVT
REQUEST HB_GT_WGU
RETURN NIL
/*----------------------------------------------------------------------*/
FUNCTION SetGT( nIndex, pGT )
LOCAL oldGT
STATIC pGT_:= { NIL, NIL, NIL }
oldGT := pGT_[ nIndex ]
IF PCount() == 2
pGT_[ nIndex ] := pGT
ENDIF
RETURN oldGT
/*----------------------------------------------------------------------*/
STATIC FUNCTION MyChoice( aChoices )
LOCAL scr, clr, nChoice
DEFAULT aChoices TO { "One","Two","Three","Four","Five","Six","Seven" }
scr := SaveScreen( 7,48,13,55 )
clr := SetColor( "N/W*,GR+/B*,,,GR+/B" )
nChoice := AChoice( 7, 48, 13, 55, aChoices )
SetColor( clr )
RestScreen( 7, 48, 13, 55, scr )
RETURN nChoice
//-------------------------------------------------------------------//
FUNCTION rgb( r,g,b )
RETURN r + ( g * 256 ) + ( b * 256 * 256 )
//-------------------------------------------------------------------//
FUNCTION DispStatusMsg( cMsg )
ClearStatusMsg()
/* NOTE: The GUI function used as such is not subject to autopainting */
//
Wvt_DrawLabel( MaxRow(), 60, cMsg, 6, , 0, rgb( 198, 198, 198 ), "Arial", 18, , 900 )
RETURN .t.
//-------------------------------------------------------------------//
FUNCTION ClearStatusMsg()
LOCAL nRow := Row()
LOCAL nCol := Col()
DispOutAt( MaxRow(), 42, space( 37 ), "W/W" )
SetPos( nRow, nCol )
RETURN .t.
//-------------------------------------------------------------------//
FUNCTION DoModalDialog()
LOCAL oCrt, nSel
LOCAL aPnt := WvtSetPaint( {} )
LOCAL aPaint := {}
oCrt := WvgCrt():New( , , { 4,8 }, { 12,49 }, , .T. )
oCrt:lModal := .t.
oCrt:resizable := .f.
oCrt:closable := .f.
oCrt:title := 'Modal Dialog!'
oCrt:icon := hb_dirBase() + "vr_1.ico"
oCrt:Create()
oCrt:show()
aAdd( aPaint, { "Box_V" , {|| Wvt_DrawBoxRaised( 1, 2, 11, 47 ) }, NIL, { WVT_BLOCK_BOX, 0, 0, MaxRow(), MaxCol() } } )
WvtSetPaint( aPaint )
SetColor( 'N/W' )
CLS
DO WHILE .t.
nSel := Alert( 'A modal window !;Click on parent window;Move this window', { 'OK' } )
IF nSel == 0 .OR. nSel == 1
EXIT
ENDIF
ENDDO
oCrt:Destroy()
WvtSetPaint( aPnt )
Return NIL
//----------------------------------------------------------------------//

22
harbour/contrib/gtwvg/tests/wvgmodal.prg
View File

@@ -1,7 +1,7 @@
/*
* $Id$
*/
/*
/*
* Pritpal Bedi <bedipritpal@hotmail.com>
*/
/*----------------------------------------------------------------------*/
@@ -11,7 +11,7 @@
#include "wvtwin.ch"
#include "hbgtinfo.ch"
#include "hbgtwvg.ch"
#include "wvgparts.ch"
#include "wvgparts.ch"
/*----------------------------------------------------------------------*/
@@ -44,7 +44,14 @@ FUNCTION My_Alert( cMessage, aOptions, cCaption, nInit, nTime )
RETURN DialogAlert( cCaption, cMessage, aOptions, nInit, , ,nTime )
/*----------------------------------------------------------------------*/
#xUntranslate alert( =>
FUNCTION Just_Alert( cMsg, aOpt )
RETURN Alert( cMsg, aOpt )
#xTranslate Alert( => MyAlert(
/*----------------------------------------------------------------------*/
#define DLG_CLR_MOUSE 1
#define DLG_CLR_CAPT 2
#define DLG_CLR_TEXT 3
@@ -53,7 +60,7 @@ FUNCTION My_Alert( cMessage, aOptions, cCaption, nInit, nTime )
#define DLG_CLR_SHADOW 6
#define DLG_CLR_HILITE 7
#define DLG_CLR_HISEL 8
#define K_MOVING 1001
#define K_LEFT_DOWN 1002
#define K_LEFT_DBLCLICK 1006
@@ -315,6 +322,7 @@ FUNCTION CreateOCrt( nT, nL, nB, nR, cTitle, xIcon, lModal, lRowCols, lHidden, ;
FUNCTION DoModalWindow()
LOCAL oCrt, nSel, pGT
LOCAL aLastPaint := WvtSetBlocks( {} )
/* This part can be clubbed in a separate prg for different dialogs
* OR can be loaded from a data dictionary.
@@ -341,7 +349,7 @@ FUNCTION DoModalWindow()
SetColor( 'N/W' )
CLS
do while .t.
nSel := alert( 'I am in modal window !;< Try: MMove LBUp RBUp >;Click Parent Window', { 'OK' } )
nSel := Just_Alert( 'I am in modal window !;< Try: MMove LBUp RBUp >;Click Parent Window', { 'OK' } )
if nSel == 0 .or. nSel == 1
exit
@@ -351,6 +359,8 @@ FUNCTION DoModalWindow()
SetGT( 3, pGT )
oCrt:Destroy()
WvtSetBlocks( aLastPaint )
Return NIL
//----------------------------------------------------------------------//

7
harbour/contrib/gtwvg/tests/wvgtbrowser.prg
View File

@@ -58,7 +58,7 @@ FUNCTION WvtMyBrowse()
//----------------------------------------------------------------------//
FUNCTION ExecBrowser( oCrt )
LOCAL nKey, bBlock, oBrowse , aLastPaint, i, aLastPaint1, pGT
LOCAL nKey, bBlock, oBrowse , aLastPaint, i, pGT
LOCAL cFileIndex, cFileDbf, cRDD, nIndex, oTBar, cScr, info_
LOCAL lEnd := .f.
LOCAL aBlocks := {}
@@ -150,7 +150,7 @@ FUNCTION ExecBrowser( oCrt )
While !lEnd
oBrowse:ForceStable()
nKey := InKey( 0, INKEY_ALL )
nKey := InKey( 0, INKEY_ALL + HB_INKEY_GTEVENT )
do case
case nKey == K_F12
@@ -163,6 +163,7 @@ FUNCTION ExecBrowser( oCrt )
case nKey == K_F6
hb_gtInfo( HB_GTI_RESIZABLE, .f. )
case nKey == K_F7
hb_gtInfo( HB_GTI_RESIZABLE, .t. )
@@ -187,9 +188,7 @@ FUNCTION ExecBrowser( oCrt )
oBrowse:RefreshAll()
case nKey == K_F3
aLastPaint1 := WvtSetBlocks( {} )
DoModalWindow()
WvtSetBlocks( aLastPaint1 )
case nKey == K_F4
hb_gtInfo( HB_GTI_SPEC, HB_GTS_WNDSTATE, HB_GTS_WS_MAXIMIZED )

58
harbour/contrib/gtwvg/tests/wvgutilities.prg
View File

@@ -1,8 +1,8 @@
/*
* $Id$
*/
/*
/*
* Pritpal Bedi <bedipritpal@hotmail.com>
*/
/*----------------------------------------------------------------------*/
@@ -12,7 +12,7 @@
#include "wvtwin.ch"
#include "hbgtinfo.ch"
#include "hbgtwvg.ch"
#include "wvgparts.ch"
#include "wvgparts.ch"
/*----------------------------------------------------------------------*/
//
@@ -209,7 +209,7 @@ FUNCTION Wvt_Mouse( nKey, nRow, nCol )
ENDCASE
RETURN NIL
//-------------------------------------------------------------------//
// WvtSetBlocks() is a get/set FUNCTION to be used by Wvt_Paint()
//-------------------------------------------------------------------//
@@ -226,7 +226,7 @@ FUNCTION WvtSetBlocks( a_ )
ENDIF
RETURN o
//-------------------------------------------------------------------//
// WvtSetObjects() is a get/set FUNCTION to be used by Wvt_Mouse()
//-------------------------------------------------------------------//
@@ -255,7 +255,7 @@ FUNCTION WvtSetObjects( aObject )
endif
RETURN oObjects
//-------------------------------------------------------------------//
FUNCTION SetMouseCheck( lYes )
@@ -268,7 +268,7 @@ FUNCTION SetMouseCheck( lYes )
endif
RETURN lOYes
//-------------------------------------------------------------------//
FUNCTION WvtWindowExpand( nUnits )
@@ -280,12 +280,12 @@ FUNCTION WvtWindowExpand( nUnits )
Wvt_setFont( "Courier New", sUnits )
RETURN .t.
//-------------------------------------------------------------------//
FUNCTION rgb( r,g,b )
RETURN r + ( g * 256 ) + ( b * 256 * 256 )
//-------------------------------------------------------------------//
FUNCTION VouChoice( aChoices )
@@ -302,13 +302,13 @@ FUNCTION VouChoice( aChoices )
RestScreen( 7, 48, 13, 55, scr )
RETURN nChoice
//-------------------------------------------------------------------//
FUNCTION Hb_Clear()
CLS
RETURN .f.
//----------------------------------------------------------------------//
FUNCTION MyMenuProcedure( nID )
@@ -319,7 +319,7 @@ FUNCTION MyMenuProcedure( nID )
alert( 'Procedure 102' )
endcase
Return .t.
//----------------------------------------------------------------------//
FUNCTION BuildWvgToolBar( oDA, nActiveX )
@@ -352,29 +352,29 @@ FUNCTION BuildWvgToolBar( oDA, nActiveX )
oTBar:addItem( "Hide" , hb_DirBase() + 'v_notes1.bmp' )
RETURN oTBar
//----------------------------------------------------------------------//
FUNCTION SetGT( nIndex, pGT )
LOCAL oldGT
STATIC pGT_:= { NIL, NIL, NIL }
oldGT := pGT_[ nIndex ]
IF !empty( pGT )
IF PCount() == 2
pGT_[ nIndex ] := pGT
ENDIF
ENDIF
RETURN oldGT
/*----------------------------------------------------------------------*/
FUNCTION SetFonts( hFont )
LOCAL oldFont
thread STATIC t_ahFonts := {}
oldFont := t_ahFonts
IF !empty( hFont )
aadd( t_ahFonts, hFont )
ENDIF
ENDIF
RETURN oldFont
/*----------------------------------------------------------------------*/
FUNCTION SetIcons( hIcon )
@@ -383,9 +383,9 @@ FUNCTION SetIcons( hIcon )
oldIcon := t_ahIcons
IF !empty( hIcon )
aadd( t_ahIcons, hIcon )
ENDIF
ENDIF
RETURN oldIcon
/*----------------------------------------------------------------------*/
FUNCTION Popups( nID, lDestroy )
@@ -455,15 +455,15 @@ FUNCTION Popups( nID, lDestroy )
hPop_[ nID ] := hPop
RETURN Wvt_SetPopupMenu( hPop_[ nID ] )
//-------------------------------------------------------------------//
FUNCTION DispStatusMsg( cMsg )
Wvt_DrawLabel( MaxRow(), 60, cMsg, 6, , 0, rgb(198,198,198), "Arial", 18, , 900 )
RETURN .t.
//-------------------------------------------------------------------//
FUNCTION ClearStatusMsg()
@@ -475,7 +475,7 @@ FUNCTION ClearStatusMsg()
SetPos( nRow, nCol )
RETURN .t.
//-------------------------------------------------------------------//
FUNCTION WvtPictures( nSlot,cFilePic )
@@ -489,7 +489,7 @@ FUNCTION WvtPictures( nSlot,cFilePic )
endif
RETURN NIL
//-------------------------------------------------------------------//
FUNCTION WvtExePicture( nTop, nLeft, nBottom, nRight, nSlot, aOffset )
@@ -499,11 +499,11 @@ FUNCTION WvtExePicture( nTop, nLeft, nBottom, nRight, nSlot, aOffset )
endif
RETURN NIL
/*----------------------------------------------------------------------*/
FUNCTION GetResource( cName )
RETURN hb_dirBase() + cName
/*----------------------------------------------------------------------*/