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

2012-06-04 11:28 UTC+0200 Viktor Szakats (harbour syenar.net)

Browse Source 
* contrib/hbformat/hbfmtcls.prg
    + DispOutAt

  * contrib/hbnetio/utils/hbnetioq/netiosrq.prg
  * contrib/gtwvg/wvgclass.prg
  * contrib/gtwvg/wvgdlg.prg
  * contrib/gtwvg/wvgpaint.prg
  * contrib/gtwvg/wvgtoolb.prg
  * contrib/gtwvg/tests/wvgtbrowser.prg
  * contrib/gtwvg/tests/demoxbp.prg
  * contrib/gtwvg/tests/wvgxbp.prg
  * contrib/gtwvg/tests/wvgactivex.prg
  * contrib/gtwvg/wvgwnd.prg
  * contrib/gtwvg/wvgdatar.prg
  * contrib/gtwvg/wvgsysw.prg
  * contrib/gtwvg/wvgmenub.prg
  * contrib/gtwvg/wvgphdlr.prg
  * contrib/gtwvg/wvgbitmp.prg
  * contrib/gtwvg/wvgstatc.prg
  * contrib/xhb/decode.prg
  * contrib/xhb/ttable.prg
  * contrib/hbide/ideconsole.prg
  * tests/db_brows.prg
  * tests/inkeytst.prg
  * tests/ifinline.prg
  * tests/inifiles.prg
  * tests/test_all.prg
  * tests/fsplit.prg
    * '<>' -> '!=' or '!( == )'
      caught a few _SET_EXACT dependend code too.
This commit is contained in:
Viktor Szakats
2012-06-04 09:30:51 +00:00
parent 68b4766b96
commit a6fbc56731
27 changed files with 1053 additions and 945 deletions
Download Patch File Download Diff File Expand all files Collapse all files

32
harbour/ChangeLog
View File

@@ -16,6 +16,38 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-06-04 11:28 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/hbformat/hbfmtcls.prg
+ DispOutAt
* contrib/hbnetio/utils/hbnetioq/netiosrq.prg
* contrib/gtwvg/wvgclass.prg
* contrib/gtwvg/wvgdlg.prg
* contrib/gtwvg/wvgpaint.prg
* contrib/gtwvg/wvgtoolb.prg
* contrib/gtwvg/tests/wvgtbrowser.prg
* contrib/gtwvg/tests/demoxbp.prg
* contrib/gtwvg/tests/wvgxbp.prg
* contrib/gtwvg/tests/wvgactivex.prg
* contrib/gtwvg/wvgwnd.prg
* contrib/gtwvg/wvgdatar.prg
* contrib/gtwvg/wvgsysw.prg
* contrib/gtwvg/wvgmenub.prg
* contrib/gtwvg/wvgphdlr.prg
* contrib/gtwvg/wvgbitmp.prg
* contrib/gtwvg/wvgstatc.prg
* contrib/xhb/decode.prg
* contrib/xhb/ttable.prg
* contrib/hbide/ideconsole.prg
* tests/db_brows.prg
* tests/inkeytst.prg
* tests/ifinline.prg
* tests/inifiles.prg
* tests/test_all.prg
* tests/fsplit.prg
* '<>' -> '!=' or '!( == )'
caught a few _SET_EXACT dependend code too.
2012-06-04 01:14 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/hbtip/thtml.prg
! typo in prev

2
harbour/contrib/gtwvg/tests/demoxbp.prg
View File

@@ -122,7 +122,7 @@ FUNCTION Main()
oTree:create()
oTree:setColorBG( RGB( 120,15,240 ) )
oTree:setColorFG( RGB( 15,240,120 ) )
oTree:itemSelected := {|oItem| IF( oItem <> NIL, WVG_MessageBox( , oItem:caption ), NIL ) }
oTree:itemSelected := {|oItem| IF( oItem != NIL, WVG_MessageBox( , oItem:caption ), NIL ) }
oItem1 := oTree:rootItem:addItem( "First level A" )

2
harbour/contrib/gtwvg/tests/wvgactivex.prg
View File

@@ -188,7 +188,7 @@ FUNCTION ExecuteActiveX( nActiveX, xParam )
oTree:create()
oTree:setColorBG( RGB( 120,15,240 ) )
oTree:setColorFG( RGB( 15,240,120 ) )
oTree:itemSelected := {|oItem| IF( oItem <> NIL, WVG_MessageBox( , oItem:caption ), NIL ) }
oTree:itemSelected := {|oItem| IF( oItem != NIL, WVG_MessageBox( , oItem:caption ), NIL ) }
oItem1 := oTree:rootItem:addItem( "First level A" )

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

@@ -311,7 +311,7 @@ STATIC FUNCTION BrwBuildTree( oCrt /*, oBrw*/ )
oTree:create( , , { -24, -1 }, { {|| -( maxrow()-1-24 ) }, -10 } )
oTree:setColorFG( "W+" )
oTree:setColorBG( "R*" )
oTree:itemSelected := {|oItem| WVG_MessageBox( , iif( oItem <> NIL, oItem:caption, "Some Problem" ) ) }
oTree:itemSelected := {|oItem| WVG_MessageBox( , iif( oItem != NIL, oItem:caption, "Some Problem" ) ) }
oItem1 := oTree:rootItem:addItem( "First level A" )
@@ -1033,4 +1033,3 @@ FUNCTION ConfigBrowser( aFields, cUseAlias, aTLBR, cDesc, oParent, cColorSpec, n
RETURN oWvtBrw
//-------------------------------------------------------------------//

2
harbour/contrib/gtwvg/tests/wvgxbp.prg
View File

@@ -120,7 +120,7 @@ FUNCTION demoxbp()
oTree:create()
oTree:setColorBG( RGB( 120,15,240 ) )
oTree:setColorFG( RGB( 15,240,120 ) )
oTree:itemSelected := {|oItem| IF( oItem <> NIL, WVG_MessageBox( , oItem:caption ), NIL ) }
oTree:itemSelected := {|oItem| IF( oItem != NIL, WVG_MessageBox( , oItem:caption ), NIL ) }
oItem1 := oTree:rootItem:addItem( "First level A" )

2
harbour/contrib/gtwvg/wvgbitmp.prg
View File

@@ -137,7 +137,7 @@ METHOD create( oPScompat ) CLASS WvgBitmap
METHOD destroy() CLASS WvgBitmap
IF ::hBitmap <> nil
IF ::hBitmap != nil
WVG_DeleteObject( ::hBitmap )
ENDIF
IF ::lDCtoDestroy

64
harbour/contrib/gtwvg/wvgclass.prg
View File

@@ -252,13 +252,13 @@ METHOD wvtDialog:Create()
LOCAL aPalette, i, j
::oldToolTipActive := Wvt_SetToolTipActive( .t. )
IF ::nTooltipWidth <> nil
IF ::nTooltipWidth != nil
Wvt_setTooltipWidth( ::nTooltipWidth )
ENDIF
IF ::nTooltipBkColor <> nil
IF ::nTooltipBkColor != nil
Wvt_SetTooltipBkColor( ::nTooltipBkColor )
ENDIF
IF ::nTooltipTextColor <> nil
IF ::nTooltipTextColor != nil
Wvt_SetTooltipTextColor( ::nTooltipTextColor )
ENDIF
@@ -343,7 +343,7 @@ METHOD wvtDialog:Destroy()
SetColor( ::cOldColor )
SetCursor( ::nOldCursor )
IF ::oldMenuHandle <> nil .and. ::oldMenuHandle <> 0
IF ::oldMenuHandle != nil .and. ::oldMenuHandle != 0
Wvt_SetMenu( ::oldMenuHandle )
ENDIF
SetKey( Wvt_SetMenuKeyEvent(), ::oldMenuBlock )
@@ -380,7 +380,7 @@ METHOD wvtDialog:Execute()
ENDIF
ENDDO
ELSE
DO WHILE ( ::Inkey() <> K_ESC )
DO WHILE ( ::Inkey() != K_ESC )
ENDDO
ENDIF
@@ -397,7 +397,7 @@ METHOD wvtDialog:Inkey()
::nKey := ::Event()
::OnTimer()
IF ::nKey <> 0
IF ::nKey != 0
IF ::nKey == K_ESC .or. ::nKey == K_CTRL_ENTER
RETURN K_ESC
ENDIF
@@ -438,7 +438,7 @@ METHOD wvtDialog:Inkey()
::MouseOver()
IF ::nObjOver == 0
Wvt_SetPointer( WVT_IDC_ARROW )
ELSEIF ::oObjOver:nPointer <> nil .and. ::oObjOver:lActive
ELSEIF ::oObjOver:nPointer != nil .and. ::oObjOver:lActive
Wvt_SetPointer( ::oObjOver:nPointer )
ELSE
Wvt_SetPointer( WVT_IDC_ARROW )
@@ -480,7 +480,7 @@ METHOD wvtDialog:Inkey()
ENDIF
ENDIF
IF ::nLastOver <> ::nObjOver
IF ::nLastOver != ::nObjOver
IF ::nLastOver > 0
::aObjects[ ::nLastOver ]:HoverOff()
ENDIF
@@ -503,7 +503,7 @@ METHOD wvtDialog:Inkey()
ENDIF
ENDIF
IF ::nCurObj <> ::nLastObj
IF ::nCurObj != ::nLastObj
IF ::nLastObj == 0
::aObjects[ ::nCurObj ]:Hilite()
@@ -613,8 +613,8 @@ METHOD wvtDialog:MouseOver()
LOCAL nObj
nObj := ascan( ::aObjects, ;
{|o| o:nType <> DLG_OBJ_STATIC .AND. ;
o:nType <> DLG_OBJ_TOOLBAR .AND. ;
{|o| o:nType != DLG_OBJ_STATIC .AND. ;
o:nType != DLG_OBJ_TOOLBAR .AND. ;
mRow >= o:nTop .AND. mRow <= o:nBottom .AND. ;
mCol >= o:nLeft .AND. mCol <= o:nRight } )
@@ -939,12 +939,12 @@ METHOD WvtObject:Create()
METHOD WvtObject:Destroy()
IF ::hFont <> nil
IF ::hFont != nil
WVG_DeleteObject( ::hFont )
::hFont := nil
ENDIF
IF ::hPopup <> nil
IF ::hPopup != nil
Wvt_DestroyMenu( ::hPopup )
::hPopup := nil
ENDIF
@@ -976,7 +976,7 @@ METHOD WvtObject:CreatePopup()
METHOD WvtObject:ShowPopup()
LOCAL lRet := .f., nRet, n, aPos
IF ::hPopup <> nil
IF ::hPopup != nil
aPos := Wvt_GetCursorPos()
nRet := Wvt_TrackPopupMenu( ::hPopup, TPM_CENTERALIGN +TPM_RETURNCMD, ;
@@ -1239,7 +1239,7 @@ METHOD WvtBrowse:SetTooltip()
::RestSettings()
ENDIF
IF cTip <> nil
IF cTip != nil
::Tooltip := cTip
ENDIF
@@ -1261,7 +1261,7 @@ METHOD WvtBrowse:SaveSettings()
METHOD WvtBrowse:RestSettings()
IF ::xSettings <> nil .and. ISBLOCK( ::bRestSettings )
IF ::xSettings != nil .and. ISBLOCK( ::bRestSettings )
Eval( ::bRestSettings, self )
ENDIF
@@ -1381,7 +1381,7 @@ METHOD WvtStatusBar:SetPanels( aPanels )
aadd( ::aPanels, oPanel )
IF aPanels <> nil
IF aPanels != nil
FOR i := 1 to len( aPanels )
IF ::oParent:MaxCol() > aPanels[ i ]
oPanel := WvtPanel():New( ::oParent, ++nID, ::nTop, aPanels[ i ] )
@@ -1486,7 +1486,7 @@ METHOD WvtPanel:New( oParent, nId, nTop, nLeft )
METHOD WvtPanel:Refresh()
IF ::Text <> nil
IF ::Text != nil
DispOutAt( ::nTop, ::nLeft+1, ::Text, ::cColor )
ENDIF
@@ -1542,7 +1542,7 @@ METHOD WvtLabel:Create( lConfg )
::hFont := Wvt_CreateFont( ::cFont, ::nFontHeight, ::nFontWidth, ::nFontWeight, ::lItalic,;
::lUnderline, ::lStrikeout, ::nCharSet, ::nFontQuality, ::nAngle )
IF ::hFont <> 0
IF ::hFont != 0
IF !( lConfg )
::bPaint := {|| Wvt_DrawLabelObj( ::nTop, ::nLeft, ::nBottom, ::nRight,;
::Text, ::nAlignHorz, ::nAlignVert, ::nTextColor, ::nBackColor, ::hFont ) }
@@ -1604,7 +1604,7 @@ METHOD WvtLabel:Configure()
::nTextColorHoverOff := ::nTextColor
::nBackColorHoverOff := ::nBackColor
IF ::hFont <> 0
IF ::hFont != 0
WVG_DeleteObject( ::hFont )
ENDIF
@@ -1618,11 +1618,11 @@ METHOD WvtLabel:Configure()
METHOD WvtLabel:HoverOn()
LOCAL lOn := .f.
IF ::nTextColorHoverOn <> nil
IF ::nTextColorHoverOn != nil
lOn := .t.
::nTextColor := ::nTextColorHoverOn
ENDIF
IF ::nBackColorHoverOn <> nil
IF ::nBackColorHoverOn != nil
lOn := .t.
::nBackColor := ::nBackColorHoverOn
ENDIF
@@ -1638,11 +1638,11 @@ METHOD WvtLabel:HoverOn()
METHOD WvtLabel:HoverOff()
LOCAL lOn := .f.
IF ::nTextColorHoverOn <> nil
IF ::nTextColorHoverOn != nil
lOn := .t.
::nTextColor := ::nTextColorHoverOff
ENDIF
IF ::nBackColorHoverOn <> nil
IF ::nBackColorHoverOn != nil
lOn := .t.
::nBackColor := ::nBackColorHoverOff
ENDIF
@@ -1985,7 +1985,7 @@ METHOD WvtImage:Create()
METHOD WvtImage:SetImage( cImage )
IF cImage <> nil .and. file( cImage )
IF cImage != nil .and. file( cImage )
::cImageFile := cImage
::Refresh()
ENDIF
@@ -2721,7 +2721,7 @@ METHOD wvtScrollbar:HandleEvent( nKey )
DO CASE
CASE ::lAnchored .and. nKey == K_MMLEFTDOWN
IF nmRow <> ::nThumbPos
IF nmRow != ::nThumbPos
nOff := ::nThumbPos - nmRow
IF nOff > 0
::nThumbPos := max( ::nTop+1, nmRow )
@@ -3018,7 +3018,7 @@ METHOD WvtBanner:OnTimer()
METHOD WvtBanner:SetText( cText )
IF cText <> nil
IF cText != nil
::cText := cText
::Refresh()
ENDIF
@@ -3124,7 +3124,7 @@ METHOD WvtTextBox:Create()
::nFontWeight, ::lItalic, ::lUnderline, ::lStrikeout, ;
::nCharSet, ::nFontQuality, 0 )
IF ::hFont <> 0
IF ::hFont != 0
::bPaint := {|| Wvt_DrawTextBox( ::nTop, ::nLeft, ::nBottom, ::nRight, ;
::aPxlTLBR, ::cText, ::nAlignHorz, ::nAlignVert, ;
::nTextColor, ::nBackColor, ::nBackMode, ::hFont ) }
@@ -3154,7 +3154,7 @@ METHOD WvtTextBox:Configure()
METHOD WvtTextBox:SetText( cText )
IF cText <> nil
IF cText != nil
::cText := cText
::Refresh()
ENDIF
@@ -3165,7 +3165,7 @@ METHOD WvtTextBox:SetText( cText )
METHOD WvtTextBox:HoverOn( /*cText*/ )
IF ::nTextColorHoverOn <> nil
IF ::nTextColorHoverOn != nil
::nTextColor := ::nTextColorHoverOn
::Refresh()
ENDIF
@@ -3176,7 +3176,7 @@ METHOD WvtTextBox:HoverOn( /*cText*/ )
METHOD WvtTextBox:HoverOff( /*cText*/ )
IF ::nTextColorHoverOn <> nil
IF ::nTextColorHoverOn != nil
::nTextColor := ::nTextColorHoverOff
::Refresh()
ENDIF
@@ -3517,7 +3517,7 @@ METHOD WvtConsole:New( oParent )
METHOD WvtConsole:Say( nRow, nCol, xExp, cColor )
LOCAL nCRow, nCCol, nCursor
IF nRow >=0 .and. nCol >= 0 .and. xExp <> nil
IF nRow >=0 .and. nCol >= 0 .and. xExp != nil
nCursor := SetCursor( SC_NONE )
nCRow := Row()
nCCol := Col()

6
harbour/contrib/gtwvg/wvgdatar.prg
View File

@@ -154,7 +154,7 @@ METHOD WvgDataRef:setData( xValue, mp2 )
IF hb_isBlock( ::dataLink )
::sl_editBuffer := eval( ::dataLink )
ELSEIF xValue <> NIL
ELSEIF xValue != NIL
::sl_editBuffer := xValue
ENDIF
@@ -169,7 +169,7 @@ METHOD WvgDataRef:setData( xValue, mp2 )
ENDIF
CASE ::className == "SysTreeView32"
IF ::sl_editBuffer <> NIL .and. ::sl_editBuffer:hItem <> NIL
IF ::sl_editBuffer != NIL .and. ::sl_editBuffer:hItem != NIL
WVG_TreeView_SelectItem( ::hWnd, ::sl_editBuffer:hItem )
ENDIF
@@ -179,7 +179,7 @@ METHOD WvgDataRef:setData( xValue, mp2 )
ENDIF
CASE ::className == "SCROLLBAR"
IF ::sl_editBuffer <> NIL
IF ::sl_editBuffer != NIL
WAPI_SetScrollPos( ::pWnd, SB_CTL, ::sl_editBuffer, .t. )
ENDIF

6
harbour/contrib/gtwvg/wvgdlg.prg
View File

@@ -212,13 +212,13 @@ METHOD WvgDialog:setFrameState( nState )
DO CASE
CASE nState == WVGDLG_FRAMESTAT_MINIMIZED
RETURN ( ::sendMessage( WM_SYSCOMMAND, SC_MINIMIZE, 0 ) <> 0 )
RETURN ( ::sendMessage( WM_SYSCOMMAND, SC_MINIMIZE, 0 ) != 0 )
CASE nState == WVGDLG_FRAMESTAT_MAXIMIZED
RETURN ( ::sendMessage( WM_SYSCOMMAND, SC_MAXIMIZE, 0 ) <> 0 )
RETURN ( ::sendMessage( WM_SYSCOMMAND, SC_MAXIMIZE, 0 ) != 0 )
CASE nState == WVGDLG_FRAMESTAT_NORMALIZED
RETURN ( ::sendMessage( WM_SYSCOMMAND, SC_RESTORE, 0 ) <> 0 )
RETURN ( ::sendMessage( WM_SYSCOMMAND, SC_RESTORE, 0 ) != 0 )
ENDCASE

2
harbour/contrib/gtwvg/wvgmenub.prg
View File

@@ -169,7 +169,7 @@ METHOD WvgMenuBar:create( oParent, aPresParams, lVisible )
::hMenu := WVG_CreateMenu()
IF ::hMenu <> 0
IF ::hMenu != 0
/* check for if the parent already has a menu
we need to destroy that first
TO DO

12
harbour/contrib/gtwvg/wvgpaint.prg
View File

@@ -91,7 +91,7 @@ function WvtPaintObjects()
for i := 1 to nBlocks
lExe := .t.
if aBlocks[ i,3 ] <> nil .and. !empty( aBlocks[ i,3 ] )
if aBlocks[ i,3 ] != nil .and. !empty( aBlocks[ i,3 ] )
/* Check parameters against tlbr_ depending upon the
* type of object and attributes contained in aAttr
*/
@@ -152,7 +152,7 @@ function WvtSetPaint( a_ )
o := t
if a_ <> nil
if a_ != nil
t := a_
endif
@@ -163,7 +163,7 @@ function WvtSetPaint( a_ )
function wvg_SetPaint( cID, nAction, xData, aAttr )
local n, n1, oldData
if xData <> nil
if xData != nil
if ( n := ascan( t_paint_, { |e_| e_[ 1 ] == cID } ) ) > 0
if ( n1 := ascan( t_paint_[ n,2 ], {|e_| e_[ 1 ] == nAction } ) ) > 0
oldData := t_paint_[ n,2,n1,2 ]
@@ -436,8 +436,8 @@ Function Wvt_CreateDialog( acnDlg, lOnTop, cbDlgProc, ncIcon, nTimerTicks, hMenu
hDlg := Wvt_CreateDialogDynamic( xTemplate, lOnTop, cbDlgProc, nDlgMode )
if hDlg <> 0
if ncIcon <> nil
if hDlg != 0
if ncIcon != nil
Wvt_DlgSetIcon( hDlg, ncIcon )
endif
@@ -447,7 +447,7 @@ Function Wvt_CreateDialog( acnDlg, lOnTop, cbDlgProc, ncIcon, nTimerTicks, hMenu
endif
if hMenu <> nil
if hMenu != nil
WVG_SetMenu( hDlg, hMenu )
endif

3
harbour/contrib/gtwvg/wvgphdlr.prg
View File

@@ -182,7 +182,7 @@ METHOD WvgPartHandler:childFromName( nNameId )
LOCAL i, oWvg
FOR i := 1 TO len( ::aChildren )
IF ::aChildren[ i ]:nNameID <> NIL .and. ::aChildren[ i ]:nNameID == nNameID
IF ::aChildren[ i ]:nNameID != NIL .and. ::aChildren[ i ]:nNameID == nNameID
oWvg := ::aChildren[ i ]
ENDIF
NEXT
@@ -594,4 +594,3 @@ METHOD WvgPartHandler:controlWndProc( hWnd, nMessage, nwParam, nlParam )
RETURN WVG_CallWindowProc( ::nOldProc, hWnd, nMessage, nwParam, nlParam )
/*----------------------------------------------------------------------*/

4
harbour/contrib/gtwvg/wvgstatc.prg
View File

@@ -278,7 +278,7 @@ METHOD WvgStatic:handleEvent( nMessage, aNM )
METHOD WvgStatic:destroy()
IF ::hBitmap <> nil
IF ::hBitmap != nil
WVG_DeleteObject( ::hBitmap )
ENDIF
::wvgWindow:destroy()
@@ -305,7 +305,7 @@ METHOD WvgStatic:setCaption( xCaption, cDll )
WVG_SendMessageText( ::hWnd, WM_SETTEXT, 0, ::caption )
CASE ::type == WVGSTATIC_TYPE_BITMAP
IF ::hBitmap <> nil
IF ::hBitmap != nil
WVG_DeleteObject( ::hBitmap )
ENDIF

6
harbour/contrib/gtwvg/wvgsysw.prg
View File

@@ -569,7 +569,7 @@ METHOD configure( cFontName ) CLASS WvgFont
METHOD destroy() CLASS WvgFont
IF ::hFont <> NIL
IF ::hFont != NIL
WVG_DeleteObject( ::hFont )
ENDIF
@@ -587,12 +587,12 @@ METHOD list() CLASS WvgFont
METHOD createFont() CLASS WvgFont
LOCAL aFont
IF ::hFont <> NIL
IF ::hFont != NIL
WVG_DeleteObject( ::hFont )
::hFont := NIL
ENDIF
IF ::oPS <> NIL
IF ::oPS != NIL
::height := Wvg_PointSizeToHeight( ::oPS:hdc, ::nominalPointSize )
ENDIF

6
harbour/contrib/gtwvg/wvgtoolb.prg
View File

@@ -251,13 +251,13 @@ METHOD WvgToolBar:destroy()
IF ( nItems := Len( ::aItems ) ) > 0
FOR i := 1 TO nItems
IF ::aItems[ i,2 ]:image <> NIL
IF ::aItems[ i,2 ]:image != NIL
WVG_DeleteObject( ::aItems[ i,2 ]:image )
ENDIF
IF ::aItems[ i,2 ]:disabledImage <> NIL
IF ::aItems[ i,2 ]:disabledImage != NIL
WVG_DeleteObject( ::aItems[ i,2 ]:disabledImage )
ENDIF
IF ::aItems[ i,2 ]:hotImage <> NIL
IF ::aItems[ i,2 ]:hotImage != NIL
WVG_DeleteObject( ::aItems[ i,2 ]:hotImage )
ENDIF
NEXT

7
harbour/contrib/gtwvg/wvgwnd.prg
View File

@@ -263,7 +263,7 @@ CLASS WvgWindow INHERIT WvgPartHandler
METHOD dragMotion( xParam ) SETGET
METHOD dragLeave( xParam ) SETGET
METHOD dragDrop( xParam, xParam1 ) SETGET
PROTECTED:
PROTECTED:
METHOD getPosAndSize( aPs, aSz )
METHOD isParentCrt() INLINE ( ::oParent:objType == objTypeCrt )
METHOD rePosition()
@@ -356,7 +356,7 @@ METHOD WvgWindow:destroy()
WVG_DestroyWindow( ::hWnd )
ENDIF
IF ::hBrushBG <> NIL
IF ::hBrushBG != NIL
WVG_DeleteObject( ::hBrushBG )
ENDIF
@@ -496,7 +496,7 @@ METHOD WvgWindow:setColorBG( nRGB )
ENDIF
IF hb_isNumeric( nRGB )
hBrush := WVG_CreateBrush( BS_SOLID, nRGB, 0 )
IF hBrush <> 0
IF hBrush != 0
::clr_BG := nRGB
::hBrushBG := hBrush
@@ -1387,4 +1387,3 @@ METHOD WvgWindow:createControl()
RETURN Self
/*----------------------------------------------------------------------*/

2
harbour/contrib/hbformat/hbfmtcls.prg
View File

@@ -181,7 +181,7 @@ METHOD New( aParams, cIniName ) CLASS HBFORMATCODE
"Array,Asc,AScan,ASize,ASort,At,Bin2I,Bin2L,Bin2W,Bof,Browse,CDow,Chr,CMonth,Col,CToD,CurDir," +;
"Date,Day,dbAppend,dbClearFil,dbClearInd,dbCloseAll,dbCloseArea,dbCommit,dbCreate,dbDelete,dbEdit,dbEval,Dbf,dbFilter,dbGoBottom,dbGoto,dbRecall,dbReindex,dbRelation,dbRLock,dbRSelect,dbRunLock," +;
"dbSeek,dbSelectArea,dbSetDriver,dbSetFilter,dbSetIndex,dbSetOrder,dbSetRelat,dbSkip,dbStruct,dbUnlock,dbUseArea,Deleted,Descend,DevOut,DevPos," +;
"Directory,DiskSpace,DispBegin,DispBox,DispCount,DispEnd,DispOut,DosError,Dow,DToC,DToS,Empty,Eof,ErrorBlock,ErrorLevel,Eval,Exp,FClose,FCount,FCreate,FErase,FError,FieldBlock,FieldGet,FieldName," +;
"Directory,DiskSpace,DispBegin,DispBox,DispCount,DispEnd,DispOut,DispOutAt,DosError,Dow,DToC,DToS,Empty,Eof,ErrorBlock,ErrorLevel,Eval,Exp,FClose,FCount,FCreate,FErase,FError,FieldBlock,FieldGet,FieldName," +;
"FieldPos,FieldPut,FieldWBlock,File,FkLabel,FkMax,FLock,FOpen,Found,FRead,FReadStr,FRename,FSeek,FWrite,GetEnv,HardCR,Header,iif,IndexExt,IndexKey,IndexOrd,Inkey,Int,IsAlpha,ISARRAY,ISCHARACTER," +;
"ISDATE,IsDigit,ISLOGICAL,IsLower,ISNUMBER,IsPrinter,IsUpper,I2Bin,L2Bin,LastKey,LastRec,Left,Len,Lower,LTrim,LUpdate,MakeDir,Max,MaxCol,MaxRow,MCol,MemoEdit,MemoLine,MemoRead," +;
"Memory,MemoTran,MemoWrite,MemVarBlock,Min,MLCount,MLCToPos,MLPos,Mod,Month,MPosToLC,NetErr,NetName,NextKey,NoSnow,OS,OrdBagExt,OrdBagName,OrdCreate,OrdDestroy,OrdFor,OrdKey,OrdListAdd," +;

40
harbour/contrib/hbide/ideconsole.prg
View File

@@ -1044,7 +1044,7 @@ METHOD hbCUIEditor:operate()
DO WHILE .t.
::nLastKey := inkey( 0, INKEY_ALL + HB_INKEY_GTEVENT )
IF ::nLastKey <> 0 .OR. ::nLastKey <> K_MOUSEMOVE
IF ::nLastKey != 0 .OR. ::nLastKey != K_MOUSEMOVE
EXIT
ENDIF
ENDDO
@@ -1143,7 +1143,7 @@ METHOD hbCUIEditor:operate()
::scrMsg()
ENDIF
CASE VouchInRange( ::nLastKey, K_SPACE, 254 ) .AND. ::nMode <> OBJ_MODE_SELECT
CASE VouchInRange( ::nLastKey, K_SPACE, 254 ) .AND. ::nMode != OBJ_MODE_SELECT
::scrAddTxt( 1 )
CASE ::nLastKey == K_F1 // Help
@@ -1181,7 +1181,7 @@ METHOD hbCUIEditor:operate()
ENDIF
ENDIF
CASE ::nLastKey == K_BS
IF ::nMode <> OBJ_MODE_SELECT
IF ::nMode != OBJ_MODE_SELECT
IF ::scrMovLft()
IF ::scrIsTxt()
::scrAddTxt( 3 )
@@ -1225,7 +1225,7 @@ METHOD hbCUIEditor:operate()
::scrGetProperty( nObj )
ENDIF
IF nObj > 0 .AND. ::nMode <> OBJ_MODE_SELECT
IF nObj > 0 .AND. ::nMode != OBJ_MODE_SELECT
::xRefresh := iif( ::xRefresh == OBJ_REFRESH_NIL, OBJ_REFRESH_LINE, ::xRefresh )
::nObjHilite := nObj
::scrOnFirstCol( nObj, { OBJ_O_FIELD, OBJ_O_EXP } )
@@ -1581,7 +1581,7 @@ METHOD hbCUIEditor:scrMouse()
IF nEvent == K_LDBLCLK
ELSEIF nEvent == K_MMLEFTDOWN /*K_LBUTTONDOWN */ .AND. ! lAnchored
IF ::scrChkObj() > 0 .AND. ::nMode <> OBJ_MODE_SELECT
IF ::scrChkObj() > 0 .AND. ::nMode != OBJ_MODE_SELECT
nCursor := SetCursor( 0 )
lAnchored := .t.
::nLastKey := K_F6
@@ -1606,13 +1606,13 @@ METHOD hbCUIEditor:scrToMouse( nmRow, nmCol )
LOCAL nRowOff, nColOff
nRowOff := nmRow - ::nRowCur
IF nRowOff <> 0
IF nRowOff != 0
::nRowCur += nRowOff
::nRowRep += nRowOff
ENDIF
nColOff := nmCol - ::nColCur
IF nColOff <> 0
IF nColOff != 0
::nColCur += nColOff
::nColRep += nColOff
ENDIF
@@ -2044,7 +2044,7 @@ METHOD hbCUIEditor:scrOnLastCol( nObj )
METHOD hbCUIEditor:scrOnFirstCol( nObj, type_ )
LOCAL nCur, nOff
IF ::nColRep <> ::obj_[ nObj,OBJ_COL ]
IF ::nColRep != ::obj_[ nObj,OBJ_COL ]
IF VouchInArray( ::obj_[ nObj, OBJ_TYPE ], type_ )
IF ::objIsBox( nObj )
nCur := ::nColCur
@@ -2420,7 +2420,7 @@ METHOD hbCUIEditor:scrTextPost( gst_, nMode )
nn++
NEXT
IF nMode <> 0
IF nMode != 0
del_:={}
ENDIF
aeval( ddd_,{|e| aadd( del_, e ) } )
@@ -2919,7 +2919,7 @@ METHOD hbCUIEditor:scrAddFld( nObj )
w_[ 2 ] := {| | VouchMenuM( 'MN_TYFLD' ) }
w_[ 3 ] := {|v| v := oAchGet( 2 ), iif( v == 'D', !oCPut( 8 ), iif( v == 'L', !oCPut( 1 ), .t. ) ) }
w_[ 4 ] := {|v| v := oAchGet( 2 ), iif( v <> 'N', !oCPut( 0 ), .t. ) }
w_[ 4 ] := {|v| v := oAchGet( 2 ), iif( !( v == 'N' ), !oCPut( 0 ), .t. ) }
::scrMsg( "ENTER: Starts Editing Current Selection. CTRL_ENTER: When Done." )
B_GETS HEADERS h_ VALUES v_ TITLE 'Configure Field' WHEN w_ INTO v_
@@ -2931,7 +2931,7 @@ METHOD hbCUIEditor:scrAddFld( nObj )
RETURN NIL
ENDIF
IF lastkey() <> K_ESC
IF lastkey() != K_ESC
::scrUpdateUndo()
IF nObj == 0
@@ -3249,7 +3249,7 @@ FUNCTION VouchGetArray( h_,vv_, sel_, nTop, nLft, nBtm, nRgt, title, bWhen_, bVa
HB_SYMBOL_UNUSED( hlp )
HB_SYMBOL_UNUSED( ord_ )
IF h_== NIL .OR. valtype(h_)<>'A' .OR. vv_== NIL .OR. valtype(vv_)<>'A'
IF h_== NIL .OR. !( valtype(h_) == 'A' ) .OR. vv_== NIL .OR. !( valtype(vv_) == 'A' )
RETURN {vv_, 0}
ENDIF
@@ -3380,7 +3380,7 @@ FUNCTION VouchGetArray( h_,vv_, sel_, nTop, nLft, nBtm, nRgt, title, bWhen_, bVa
FUNCTION VouchFunc1( mode, nElem, nRow, nKey, cgo_ )
LOCAL ret := AC_CONT
IF nKey <> 0
IF nKey != 0
ScrolBarUpdate( cgo_[CGO_SCROL], nElem, cgo_[CGO_LENSCR], .t. )
ENDIF
@@ -3562,7 +3562,7 @@ FUNCTION VouchYN( msg, nInit )
B_MSG msg CHOOSE 'Yes','No ' TRIGGER {1,1} INITIAL nInit ;
RESTORE SHADOW AT g:row - 3, g:col INTO sel
IF g <> NIL
IF g != NIL
g:varPut( iif( sel == 1, .t., .f. ) )
ENDIF
@@ -3930,9 +3930,9 @@ FUNCTION VouchMsgBox(r1, c1, r2, c2, width, depth, msg_, msgClr, ;
FUNCTION VouchFunc2( nMode, nElem, nRel, nKey, cgo_ )
LOCAL n, i, nn, s
IF nKey <> 0 .AND. nKey <> K_MOUSEMOVE
IF nKey != 0 .AND. nKey != K_MOUSEMOVE
ScrolBarUpdate( cgo_[ CGO_SCROL ], nElem, cgo_[ CGO_LENSCR ], .t. )
IF cgo_[ CGO_EXE_ ] <> NIL
IF cgo_[ CGO_EXE_ ] != NIL
eval( cgo_[ CGO_EXE_,nElem ] )
ENDIF
ENDIF
@@ -4047,7 +4047,7 @@ STATIC FUNCTION scan_f( elem, a_, key, nFrom )
IF na == 0
na := ascan( a_,{|e| lower( substr( e, nFrom, 1 ) ) == c },1,elem-1 )
ENDIF
IF na <> 0
IF na != 0
n := na
ENDIF
RETURN n
@@ -4149,7 +4149,7 @@ FUNCTION help( cToken )
nRows := maxrow()
nCols := maxcol()
aScr := VouchWndSave( 0, 0, maxrow(), maxcol() )
lSetMode := nRows <> 27 .or. nCols <> 79
lSetMode := nRows != 27 .or. nCols != 79
Vstk_push()
IF lSetMode
@@ -4688,7 +4688,7 @@ METHOD AChoiceNew:Exe()
ENDIF
#ifdef __WVT__
IF nLastPos <> ::nPos
IF nLastPos != ::nPos
Wvt_DrawFocusRect( ::nTop + ( ::nPos - ::nAtTop ), ::nLeft, ;
::nTop + ( ::nPos - ::nAtTop ), ::nRight )
nLastPos := ::nPos
@@ -5146,7 +5146,7 @@ METHOD AChoiceNew:DispAtNew()
.AND. ;
::mrc_[ 4 ] >= ::nLeft .AND. ::mrc_[ 4 ] <= ::nRight
IF ( nNewPos := ::nAtTop + ( ::mrc_[ 3 ] - ::nTop ) ) <> ::nPos
IF ( nNewPos := ::nAtTop + ( ::mrc_[ 3 ] - ::nTop ) ) != ::nPos
IF ::alSelect[ nNewPos ]
::DeHilite()
::nPos := nNewPos

2
harbour/contrib/hbnetio/utils/hbnetioq/netiosrq.prg
View File

@@ -237,7 +237,7 @@ METHOD NetIOMgmtClient:create( cIP, nPort, cPassword )
SetAppWindow( ::oDlg )
SetAppFocus( ::oDlg )
DO WHILE nEvent <> xbeP_Quit
DO WHILE nEvent != xbeP_Quit
nEvent := AppEvent( @mp1, @mp2, @oXbp )
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDDO

4
harbour/contrib/xhb/decode.prg
View File

@@ -109,7 +109,7 @@ FUNCTION HB_Decode(...)
nParams := Len( aParams )
// if I have a odd number of members, last is default
IF ( nParams % 2 <> 0 )
IF ( nParams % 2 != 0 )
xDefault := aTail( aParams )
// Resize again deleting last
hb_ADel( aParams, nParams, .T. )
@@ -118,7 +118,7 @@ FUNCTION HB_Decode(...)
// Ok because I have no other value than default, I will check if it is a complex value
// like an array or an hash, so I can get it to decode values
IF xDefault <> NIL .AND. ;
IF xDefault != NIL .AND. ;
( ValType( xDefault ) == "A" .OR. ;
ValType( xDefault ) == "H" )

6
harbour/contrib/xhb/ttable.prg
View File

@@ -588,7 +588,7 @@ METHOD PROCEDURE Put() CLASS HBRecord
LOCAL xField
FOR EACH xField IN ::aFields
IF xField:Value <> ::buffer[ xField:__EnumIndex() ]
IF !( xField:Value == ::buffer[ xField:__EnumIndex() ] )
xField:PUT( ::buffer[ xField:__EnumIndex() ] )
::buffer[ xField:__EnumIndex() ] := xField:value
ENDIF
@@ -1461,12 +1461,12 @@ METHOD OnError( uParam ) CLASS HBTable
LOCAL nPos
LOCAL uRet, oErr
if uParam <> nil .and. LEFT( cMsg, 1 ) == '_'
if uParam != nil .and. LEFT( cMsg, 1 ) == '_'
cMsg := SubStr( cMsg, 2 )
endif
nPos := (::Alias)->( FieldPos(cMsg) )
if nPos <> 0
if nPos != 0
uRet := (::Alias)->( if(uParam == nil, FieldGet(nPos), FieldPut(nPos, uParam)) )
else

727
harbour/tests/db_brows.prg
View File

File diff suppressed because it is too large Load Diff

254
harbour/tests/fsplit.prg
View File

@@ -1,141 +1,143 @@
/*
* $Id$
*/
*/
#include "fileio.ch"
procedure main( cSource, cSplit, nByte )
? fsplit( cSource, cSplit, VAL( nByte ) )
quit
PROCEDURE Main( cSource, cSplit, nByte )
function fsplit ( csource, csplit, nbyte )
? fsplit( cSource, cSplit, Val( nByte ) )
local i // general counter
local ccommand := "" // dos command for joining files
local cexist := "" // batch file error checker
local nbufsize := 8 // default buffer Read/Write size
local hsource := 0 // file handle for source file
local hdestination := 0 // file handle for destination file
local cbuffer := "" // buffer for read/write
local lsplit := .f. // return value
local nblock := 0 // bytes read
local ncurrent := 0 // total bytes copied
local nsplit := 1 // destination file name extension
local cbat := "join.bat" // for joining split files
local cdestination // destination filename
local hbat // file handle for join.bat
local afile := {} // for information upon completion
local nseconds := seconds() // time elapsed
local nfilesize := 0 // file size to be split
local hfile := 0 // split file sizes
local cret := chr(13) + chr(10) // carriage return
local ctmp := "@echo off" + cret // 1st line in join.bat
local nfile
RETURN
// y2k compliance
set(4,"dd/mm/yyyy")
set epoch to year(date()) - 50
FUNCTION fsplit ( csource, csplit, nbyte )
// no params passed
if pcount() == 0
? "Usage : FSPLIT <cSourceFile> [cSplitFileName] [nKBytesEach]"
return lsplit
endif
LOCAL i // general counter
LOCAL ccommand := "" // dos command for joining files
LOCAL cexist := "" // batch file error checker
LOCAL nbufsize := 8 // default buffer Read/Write size
LOCAL hsource := 0 // file handle for source file
LOCAL hdestination := 0 // file handle for destination file
LOCAL cbuffer := "" // buffer for read/write
LOCAL lsplit := .F. // return value
LOCAL nblock := 0 // bytes read
LOCAL ncurrent := 0 // total bytes copied
LOCAL nsplit := 1 // destination file name extension
LOCAL cbat := "join.bat" // for joining split files
LOCAL cdestination // destination filename
LOCAL hbat // file handle for join.bat
LOCAL afile := {} // for information upon completion
LOCAL nseconds := Seconds() // time elapsed
LOCAL nfilesize := 0 // file size to be split
LOCAL hfile := 0 // split file sizes
LOCAL cret := Chr( 13 ) + Chr( 10 ) // carriage return
LOCAL ctmp := "@echo off" + cret // 1st line in join.bat
LOCAL nfile
// default destination name
csplit := iif( csplit == nil, "split.", csplit + "." )
// y2k compliance
SET DATE ANSI
SET EPOCH TO Year( Date() ) - 50
// default size of each split file 360 x 1024 bytes
nbufsize := iif( empty( nbyte ), 360, nbyte )
nbyte := nbufsize * 1024
// no params passed
IF PCount() == 0
? "Usage : FSPLIT <cSourceFile> [cSplitFileName] [nKBytesEach]"
RETURN lsplit
ENDIF
// open the source file
BEGIN SEQUENCE
if ( hsource := fopen(csource,FO_READ+FO_SHARED) ) <> -1
// is file size smaller than chunk size ?
if ( nfilesize := fseek( hsource, 0 , FS_END ) ) <= nbyte
alert("***** Error *****;File Size Is Smaller Than Chunk Size;"+"Source Size = "+ltrim(str(nfilesize))+" Chunk Size = "+ltrim(str(nbyte)),{" Okay "},"w+/b")
fclose( hsource )
break
endif
fseek( hsource, 0, FS_SET ) // go to top of file
cdestination := csplit+ltrim(str(nsplit)) // destination file name
hbat := fcreate( cbat ) // join.bat
if hbat <> -1
else
break
endif
ctmp += "rem source file " + csource + " size "+ ltrim(str(nfilesize ) ) + cret
ctmp += "rem split on " + dtoc(date()) + " "+ time() + cret
ccommand := "copy /b " // line in join.bat
ccommand += cdestination + "+" // line in join.bat
hdestination := fcreate(cdestination) // create 1st split file
if hdestination <> - 1
nbufsize *= 1024 // buffer size
cbuffer := space( nbufsize ) // buffer read/write
aadd( afile, cbat )
aadd( afile, cdestination )
dispoutat(24,00,padr("Writing " + cdestination,80))
while !lsplit
lsplit := ( ( ( nblock := fread( hsource, @cbuffer, nbufsize ) ) == 0 ) .or. ( fwrite ( hdestination, cbuffer, nblock ) < nblock ) )
ncurrent += nblock
if ncurrent >= nbyte // files size already exceed ?
fclose( hdestination ) // close file
ncurrent := 0 // reset counter
cdestination := csplit + ltrim(str(++nsplit)) // next file name
ccommand += cdestination + "+" // line in join.bat
hdestination := fcreate(cdestination) // create next file
if hdestination <> -1
aadd( afile, cdestination )
dispoutat(24,00,padr("Writing " + cdestination,80))
else
break
endif
endif
enddo
fclose( hsource ) // close source file
fclose( hdestination ) // close split file
ccommand := left( ccommand, rat("+",ccommand ) - 1 ) + " " // line in join.bat
ccommand += csource + cret // line in join.bat
ctmp += "rem the following files should be placed in a directory"+chr(13)+chr(10)
for i := 2 to len( afile )
hfile := fopen( afile[i], FO_READ+FO_SHARED )
nfilesize := fseek( hfile, 0 , FS_END )
fclose( hfile )
ctmp += "rem " + afile[i] + " - " + ltrim( str( nfilesize ) ) + cret
next
nfile := len( afile ) // error checker
for i := 2 to nfile
ctmp += "if not exist " + afile[i] + " goto error"+ltrim(stR(i-1)) + cret
next
ctmp += ccommand
ctmp += "goto end" + cret
for i := 2 to nfile
ctmp += ":error" + ltrim(str(i-1)) + cret
ctmp += "echo " + cret
ctmp += "echo missing file " + afile[i] + cret
// default destination name
csplit := iif( csplit == nil, "split.", csplit + "." )
// default size of each split file 360 x 1024 bytes
nbufsize := iif( Empty( nbyte ), 360, nbyte )
nbyte := nbufsize * 1024
// open the source file
BEGIN SEQUENCE
IF ( hsource := FOpen( csource,FO_READ + FO_SHARED ) ) != F_ERROR
// is file size smaller than chunk size ?
IF ( nfilesize := FSeek( hsource, 0 , FS_END ) ) <= nbyte
Alert( "***** Error *****;File Size Is Smaller Than Chunk Size;" + "Source Size = " + hb_ntos( nfilesize ) + " Chunk Size = " + hb_ntos( nbyte ), { " Okay " }, "w+/b" )
FClose( hsource )
break
ENDIF
FSeek( hsource, 0, FS_SET ) // go to top of file
cdestination := csplit + hb_ntos( nsplit ) // destination file name
hbat := FCreate( cbat ) // join.bat
IF hbat != F_ERROR
ELSE
break
ENDIF
ctmp += "rem source file " + csource + " size " + hb_ntos( nfilesize ) + cret
ctmp += "rem split on " + DToC( Date() ) + " " + Time() + cret
ccommand := "copy /b " // line in join.bat
ccommand += cdestination + "+" // line in join.bat
hdestination := FCreate( cdestination ) // create 1st split file
IF hdestination != - 1
nbufsize *= 1024 // buffer size
cbuffer := Space( nbufsize ) // buffer read/write
AAdd( afile, cbat )
AAdd( afile, cdestination )
DispOutAt( 24, 00, PadR( "Writing " + cdestination,80 ) )
DO WHILE ! lsplit
lsplit := ( ( ( nblock := FRead( hsource, @cbuffer, nbufsize ) ) == 0 ) .OR. ( FWrite ( hdestination, cbuffer, nblock ) < nblock ) )
ncurrent += nblock
IF ncurrent >= nbyte // files size already exceed ?
FClose( hdestination ) // close file
ncurrent := 0 // reset counter
cdestination := csplit + hb_ntos( ++nsplit ) // next file name
ccommand += cdestination + "+" // line in join.bat
hdestination := FCreate( cdestination ) // create next file
IF hdestination != F_ERROR
AAdd( afile, cdestination )
DispOutAt( 24, 00, PadR( "Writing " + cdestination,80 ) )
ELSE
BREAK
ENDIF
ENDIF
ENDDO
FClose( hsource ) // close source file
FClose( hdestination ) // close split file
ccommand := Left( ccommand, RAt( "+",ccommand ) - 1 ) + " " // line in join.bat
ccommand += csource + cret // line in join.bat
ctmp += "rem the following files should be placed in a directory" + Chr( 13 ) + Chr( 10 )
FOR i := 2 TO Len( afile )
hfile := FOpen( afile[ i ], FO_READ + FO_SHARED )
nfilesize := FSeek( hfile, 0 , FS_END )
FClose( hfile )
ctmp += "rem " + afile[ i ] + " - " + hb_ntos( nfilesize ) + cret
NEXT
nfile := Len( afile ) // error checker
FOR i := 2 TO nfile
ctmp += "if not exist " + afile[ i ] + " goto error" + hb_ntos( i - 1 ) + cret
NEXT
ctmp += ccommand
ctmp += "goto end" + cret
next
ctmp += ":end" + cret
fwrite( hbat, upper( ctmp ) ) // write join.bat
fclose( hbat ) // close handle
? "Split succesful ..."
?
? "Files Created : "
?
aeval( afile, { |e| qout(upper(e)) } )
?
? "Done in " + ltrim(str(seconds()-nseconds)) +" seconds."
? "To restore, type JOIN"
else
FOR i := 2 TO nfile
ctmp += ":error" + hb_ntos( i - 1 ) + cret
ctmp += "echo " + cret
ctmp += "echo missing file " + afile[ i ] + cret
ctmp += "goto end" + cret
NEXT
ctmp += ":end" + cret
FWrite( hbat, Upper( ctmp ) ) // write join.bat
FClose( hbat ) // close handle
? "Split succesful ..."
?
? "Files Created : "
?
AEval( afile, {| e | QOut( Upper( e ) ) } )
?
? "Done in " + hb_ntos( Seconds() - nseconds ) + " seconds."
? "To restore, type JOIN"
ELSE
break
ENDIF
ELSE
break
endif
else
break
endif
RECOVER
? chr(7)
? "Error ...."
END SEQUENCE
ENDIF
RECOVER
? Chr( 7 )
? "Error ...."
END SEQUENCE
return lsplit
RETURN lsplit

23
harbour/tests/ifinline.prg
View File

@@ -1,27 +1,26 @@
//
// $Id$
//
/*
* $Id$
*/
// Testing Harbour If inline
/* Testing Harbour If inline */
function Main()
local n := 1
PROCEDURE Main()
LOCAL n := 1
QOut( "Testing Harbour If inline" )
If( n == 1, QOut( 1 ), QOut( 2 ) )
if( n == 1, QOut( 1 ), QOut( 2 ) )
IIf( n <> nil, QOut( "not nil" ),)
iif( n != NIL, QOut( "not NIL" ), )
QOut( "Now changing n to 2" )
n = 2
If( n == 1, QOut( 1 ), QOut( 2 ) )
if( n == 1, QOut( 1 ), QOut( 2 ) )
IIf( n <> nil, QOut( "not nil" ),)
iif( n != NIL, QOut( "not NIL" ), )
QOut( "ok!" )
return nil
RETURN

506
harbour/tests/inifiles.prg
View File

@@ -1,332 +1,364 @@
//
// $Id$
//
/*
* $Id$
*/
#define CRLF (Chr(13) + Chr(10))
function Main(cFilename, cSection)
local oIni := TIniFile():New(Default( cFilename, 'harbour.ini' ) )
local s, n := Val( Default( cSection, '1' ) )
FUNCTION Main( cFilename, cSection )
qout('')
qout('Sections:')
LOCAL oIni := TIniFile():New( Default( cFilename, "harbour.ini" ) )
LOCAL s, n := Val( Default( cSection, "1" ) )
QOut( "" )
QOut( "Sections:" )
s := oIni:ReadSections()
aeval(s, {|x| qout('[' + x + ']')})
AEval( s, {| x | QOut( "[" + x + "]" ) } )
qout('')
qout('[' + s[n] + ']')
s := oIni:ReadSection(s[n])
aeval(s, {|x| qout(x)})
QOut( "" )
QOut( "[" + s[n] + "]" )
s := oIni:ReadSection( s[n] )
AEval( s, {| x | QOut( x ) } )
oIni:WriteDate('Date Test', 'Today', Date() )
oIni:WriteBool('Bool Test', 'True', .t.)
qout( oIni:ReadBool('Bool Test', 'True', .f.) )
oIni:WriteDate( "Date Test", "Today", Date() )
oIni:WriteBool( "Bool Test", "True", .T. )
QOut( oIni:ReadBool( "Bool Test", "True", .F. ) )
oIni:UpdateFile()
return nil
function TIniFile()
static oClass
RETURN NIL
if oClass == nil
oClass := HBClass():New( 'TINIFILE' ) // starts a new class definition
FUNCTION TIniFile()
oClass:AddData( 'FileName' ) // define this class objects datas
oClass:AddData( 'Contents' )
STATIC oClass
oClass:AddMethod( 'New', @New() ) // define this class objects methods
oClass:AddMethod( 'ReadString', @ReadString() )
oClass:AddMethod( 'WriteString', @WriteString() )
oClass:AddMethod( 'ReadNumber', @ReadNumber() )
oClass:AddMethod( 'WriteNumber', @WriteNumber() )
oClass:AddMethod( 'ReadDate', @ReadDate() )
oClass:AddMethod( 'WriteDate', @WriteDate() )
oClass:AddMethod( 'ReadBool', @ReadBool() )
oClass:AddMethod( 'WriteBool', @WriteBool() )
oClass:AddMethod( 'ReadSection', @ReadSection() )
oClass:AddMethod( 'ReadSections', @ReadSections() )
oClass:AddMethod( 'DeleteKey', @DeleteKey() )
oClass:AddMethod( 'EraseSection', @EraseSection() )
oClass:AddMethod( 'UpdateFile', @UpdateFile() )
IF oClass == NIL
oClass := HBClass():New( "TINIFILE" ) // starts a new class definition
oClass:AddData( "FileName" ) // define this class objects datas
oClass:AddData( "Contents" )
oClass:AddMethod( "New", @New() ) // define this class objects methods
oClass:AddMethod( "ReadString", @ReadString() )
oClass:AddMethod( "WriteString", @WriteString() )
oClass:AddMethod( "ReadNumber", @ReadNumber() )
oClass:AddMethod( "WriteNumber", @WriteNumber() )
oClass:AddMethod( "ReadDate", @ReadDate() )
oClass:AddMethod( "WriteDate", @WriteDate() )
oClass:AddMethod( "ReadBool", @ReadBool() )
oClass:AddMethod( "WriteBool", @WriteBool() )
oClass:AddMethod( "ReadSection", @ReadSection() )
oClass:AddMethod( "ReadSections", @ReadSections() )
oClass:AddMethod( "DeleteKey", @DeleteKey() )
oClass:AddMethod( "EraseSection", @EraseSection() )
oClass:AddMethod( "UpdateFile", @UpdateFile() )
oClass:Create() // builds this class
endif
return oClass:Instance() // builds an object of this class
ENDIF
static function New(cFileName)
local Self := QSelf()
local Done, hFile, cFile, cLine, cIdent, nPos
local CurrArray
RETURN oClass:Instance() // builds an object of this class
if empty(cFileName)
STATIC FUNCTION New( cFileName )
LOCAL Self := QSelf()
LOCAL Done, hFile, cFile, cLine, cIdent, nPos
LOCAL CurrArray
IF Empty( cFileName )
// raise an error?
outerr('No filename passed to TIniFile():New()')
return nil
OutErr( "No filename passed to TIniFile():New()" )
RETURN NIL
else
ELSE
::FileName := cFilename
::Contents := {}
CurrArray := ::Contents
if File(cFileName)
hFile := fopen(cFilename, 0)
IF File( cFileName )
hFile := FOpen( cFilename, 0 )
ELSE
hFile := FCreate( cFilename )
ENDIF
else
hFile := fcreate(cFilename)
endif
cLine := ""
Done := .F.
DO WHILE !Done
cFile := Space( 256 )
Done := ( FRead( hFile, @cFile, 256 ) <= 0 )
cLine := ''
Done := .f.
while !Done
cFile := space(256)
Done := (fread(hFile, @cFile, 256) <= 0)
cFile := strtran(cFile, chr(10), '') // so we can just search for CHR(13)
cFile := StrTran( cFile, Chr( 10 ), "" ) // so we can just search for CHR(13)
// prepend last read
cFile := cLine + cFile
while !empty(cFile)
if (nPos := at(chr(13), cFile)) > 0
cLine := left(cFile, nPos - 1)
cFile := substr(cFile, nPos + 1)
DO WHILE !Empty( cFile )
IF ( nPos := At( Chr(13 ), cFile ) ) > 0
cLine := Left( cFile, nPos - 1 )
cFile := SubStr( cFile, nPos + 1 )
if !empty(cLine)
if Left(cLine, 1) == '[' // new section
if (nPos := At(']', cLine)) > 1
cLine := substr(cLine, 2, nPos - 2);
IF !Empty( cLine )
IF Left( cLine, 1 ) == "[" // new section
IF ( nPos := At( "]", cLine ) ) > 1
cLine := SubStr( cLine, 2, nPos - 2 );
else
cLine := substr(cLine, 2)
endif
else
cLine := SubStr( cLine, 2 )
ENDIF
AAdd(::Contents, { cLine, { /* this will be CurrArray */ } } )
AAdd( ::Contents, { cLine, { /* this will be CurrArray */
} } )
CurrArray := ::Contents[Len(::Contents)][2]
elseif Left(cLine, 1) == ';' // preserve comments
ELSEIF Left( cLine, 1 ) == ";" // preserve comments
AAdd( CurrArray, { NIL, cLine } )
else
if (nPos := At('=', cLine)) > 0
cIdent := Left(cLine, nPos - 1)
cLine := SubStr(cLine, nPos + 1)
ELSE
IF ( nPos := At( "=", cLine ) ) > 0
cIdent := Left( cLine, nPos - 1 )
cLine := SubStr( cLine, nPos + 1 )
AAdd( CurrArray, { cIdent, cLine } )
else
AAdd( CurrArray, { cLine, '' } )
endif
endif
cLine := '' // to stop prepend later on
endif
ELSE
AAdd( CurrArray, { cLine, "" } )
ENDIF
ENDIF
cLine := "" // to stop prepend later on
ENDIF
else
ELSE
cLine := cFile
cFile := ''
endif
end
end
cFile := ""
ENDIF
ENDDO
ENDDO
fclose(hFile)
endif
return Self
FClose( hFile )
ENDIF
static function ReadString(cSection, cIdent, cDefault)
local Self := QSelf()
local cResult := cDefault
local i, j, cFind
RETURN Self
if Empty(cSection)
cFind := lower(cIdent)
j := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cFind .and. ValType(x[2]) == 'C'} )
STATIC FUNCTION ReadString( cSection, cIdent, cDefault )
if j > 0
cResult := ::Contents[j][2]
endif
LOCAL Self := QSelf()
LOCAL cResult := cDefault
LOCAL i, j, cFind
else
cFind := lower(cSection)
i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cFind} )
IF Empty( cSection )
cFind := Lower( cIdent )
j := AScan( ::Contents, {| x | ValType( x[1] ) == "C" .AND. Lower( x[1] ) == cFind .AND. ValType( x[2] ) == "C" } )
if i > 0
cFind := lower(cIdent)
j := AScan( ::Contents[i][2], {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cFind} )
IF j > 0
cResult := ::Contents[j][2]
ENDIF
if j > 0
ELSE
cFind := Lower( cSection )
i := AScan( ::Contents, {| x | ValType( x[1] ) == "C" .AND. Lower( x[1] ) == cFind } )
IF i > 0
cFind := Lower( cIdent )
j := AScan( ::Contents[i][2], {| x | ValType( x[1] ) == "C" .AND. Lower( x[1] ) == cFind } )
IF j > 0
cResult := ::Contents[i][2][j][2]
endif
endif
endif
return cResult
ENDIF
ENDIF
ENDIF
static procedure WriteString(cSection, cIdent, cString)
local Self := QSelf()
local i, j, cFind
RETURN cResult
if Empty(cIdent)
outerr('Must specify an identifier')
STATIC PROCEDURE WriteString( cSection, cIdent, cString )
elseif Empty(cSection)
cFind := lower(cIdent)
j := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cFind .and. ValType(x[2]) == 'C'} )
LOCAL Self := QSelf()
LOCAL i, j, cFind
if j > 0
IF Empty( cIdent )
OutErr( "Must specify an identifier" )
ELSEIF Empty( cSection )
cFind := Lower( cIdent )
j := AScan( ::Contents, {| x | ValType( x[1] ) == "C" .AND. Lower( x[1] ) == cFind .AND. ValType( x[2] ) == "C" } )
IF j > 0
::Contents[j][2] := cString
else
AAdd(::Contents, nil)
AIns(::Contents, 1)
::Contents[1] := {cIdent, cString}
endif
ELSE
AAdd( ::Contents, NIL )
AIns( ::Contents, 1 )
::Contents[1] := { cIdent, cString }
ENDIF
else
cFind := lower(cSection)
if (i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cFind .and. ValType(x[2]) == 'A'})) > 0
cFind := lower(cIdent)
j := AScan( ::Contents[i][2], {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cFind} )
ELSE
cFind := Lower( cSection )
IF ( i := AScan( ::Contents, {| x | ValType(x[1] ) == "C" .AND. Lower(x[1] ) == cFind .AND. ValType(x[2] ) == "A" } ) ) > 0
cFind := Lower( cIdent )
j := AScan( ::Contents[i][2], {| x | ValType( x[1] ) == "C" .AND. Lower( x[1] ) == cFind } )
if j > 0
IF j > 0
::Contents[i][2][j][2] := cString
else
AAdd( ::Contents[i][2], {cIdent, cString} )
endif
ELSE
AAdd( ::Contents[i][2], { cIdent, cString } )
ENDIF
else
AAdd( ::Contents, {cSection, {{cIdent, cString}}} )
endif
endif
return
ELSE
AAdd( ::Contents, { cSection, { {cIdent, cString} } } )
ENDIF
ENDIF
static function ReadNumber(cSection, cIdent, nDefault)
local Self := QSelf()
return Val( ::ReadString(cSection, cIdent, str(nDefault)) )
RETURN
static procedure WriteNumber(cSection, cIdent, nNumber)
local Self := QSelf()
STATIC FUNCTION ReadNumber( cSection, cIdent, nDefault )
::WriteString( cSection, cIdent, alltrim(str(nNumber)) )
return
LOCAL Self := QSelf()
static function ReadDate(cSection, cIdent, dDefault)
local Self := QSelf()
return SToD( ::ReadString(cSection, cIdent, DToS(dDefault)) )
RETURN Val( ::ReadString( cSection, cIdent, Str(nDefault ) ) )
static procedure WriteDate(cSection, cIdent, dDate)
local Self := QSelf()
STATIC PROCEDURE WriteNumber( cSection, cIdent, nNumber )
::WriteString( cSection, cIdent, DToS(dDate) )
return
LOCAL Self := QSelf()
static function ReadBool(cSection, cIdent, lDefault)
local Self := QSelf()
local cDefault := Iif( lDefault, '.t.', '.f.' )
::WriteString( cSection, cIdent, AllTrim( Str(nNumber ) ) )
return ::ReadString(cSection, cIdent, cDefault) == '.t.'
RETURN
static procedure WriteBool(cSection, cIdent, lBool)
local Self := QSelf()
STATIC FUNCTION ReadDate( cSection, cIdent, dDefault )
::WriteString( cSection, cIdent, Iif(lBool, '.t.', '.f.') )
return
LOCAL Self := QSelf()
static procedure DeleteKey(cSection, cIdent)
local Self := QSelf()
local i, j
RETURN SToD( ::ReadString( cSection, cIdent, DToS(dDefault ) ) )
cSection := lower(cSection)
i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cSection} )
STATIC PROCEDURE WriteDate( cSection, cIdent, dDate )
if i > 0
cIdent := lower(cIdent)
j := AScan( ::Contents[i][2], {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cIdent} )
LOCAL Self := QSelf()
::WriteString( cSection, cIdent, DToS( dDate ) )
RETURN
STATIC FUNCTION ReadBool( cSection, cIdent, lDefault )
LOCAL Self := QSelf()
LOCAL cDefault := iif( lDefault, ".T.", ".F." )
return ::ReadString( cSection, cIdent, cDefault ) == ".T."
STATIC PROCEDURE WriteBool( cSection, cIdent, lBool )
LOCAL Self := QSelf()
::WriteString( cSection, cIdent, iif( lBool, ".T.", ".F." ) )
RETURN
STATIC PROCEDURE DeleteKey( cSection, cIdent )
LOCAL Self := QSelf()
LOCAL i, j
cSection := Lower( cSection )
i := AScan( ::Contents, {| x | ValType( x[1] ) == "C" .AND. Lower( x[1] ) == cSection } )
IF i > 0
cIdent := Lower( cIdent )
j := AScan( ::Contents[i][2], {| x | ValType( x[1] ) == "C" .AND. Lower( x[1] ) == cIdent } )
ADel( ::Contents[i][2], j )
ASize( ::Contents[i][2], Len(::Contents[i][2]) - 1 )
endif
return
ASize( ::Contents[i][2], Len( ::Contents[i][2] ) - 1 )
ENDIF
static procedure EraseSection(cSection)
local Self := QSelf()
local i
RETURN
if Empty(cSection)
while (i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. ValType(x[2]) == 'C'})) > 0
STATIC PROCEDURE EraseSection( cSection )
LOCAL Self := QSelf()
LOCAL i
IF Empty( cSection )
DO WHILE ( i := AScan( ::Contents, {| x | ValType(x[1] ) == "C" .AND. ValType(x[2] ) == "C" } ) ) > 0
ADel( ::Contents, i )
ASize( ::Contents, len(::Contents) - 1 )
end
ASize( ::Contents, Len( ::Contents ) - 1 )
ENDDO
else
cSection := lower(cSection)
if (i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cSection .and. ValType(x[2]) == 'A'})) > 0
ELSE
cSection := Lower( cSection )
IF ( i := AScan( ::Contents, {| x | ValType(x[1] ) == "C" .AND. Lower(x[1] ) == cSection .AND. ValType(x[2] ) == "A" } ) ) > 0
ADel( ::Contents, i )
ASize( ::Contents, Len(::Contents) - 1 )
endif
endif
return
ASize( ::Contents, Len( ::Contents ) - 1 )
ENDIF
ENDIF
static function ReadSection(cSection)
local Self := QSelf()
local i, j, aSection := {}
RETURN
if Empty(cSection)
for i := 1 to len(::Contents)
if valtype(::Contents[i][1]) == 'C' .and. valtype(::Contents[i][2]) == 'C'
aadd(aSection, ::Contents[i][1])
endif
next
STATIC FUNCTION ReadSection( cSection )
else
cSection := lower(cSection)
if (i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. x[1] == cSection .and. ValType(x[2]) == 'A'})) > 0
LOCAL Self := QSelf()
LOCAL i, j, aSection := {}
for j := 1 to Len(::Contents[i][2])
IF Empty( cSection )
FOR i := 1 TO Len( ::Contents )
IF ValType( ::Contents[i][1] ) == "C" .AND. ValType( ::Contents[i][2] ) == "C"
AAdd( aSection, ::Contents[i][1] )
ENDIF
NEXT
if ::Contents[i][2][j][1] <> NIL
AAdd(aSection, ::Contents[i][2][j][1])
endif
next
endif
endif
return aSection
ELSE
cSection := Lower( cSection )
IF ( i := AScan( ::Contents, {| x | ValType(x[1] ) == "C" .AND. x[1] == cSection .AND. ValType(x[2] ) == "A" } ) ) > 0
static function ReadSections()
local Self := QSelf()
local i, aSections := {}
FOR j := 1 TO Len( ::Contents[i][2] )
for i := 1 to Len(::Contents)
IF ::Contents[i][2][j][1] != NIL
AAdd( aSection, ::Contents[i][2][j][1] )
ENDIF
NEXT
ENDIF
ENDIF
if ValType(::Contents[i][2]) == 'A'
AAdd(aSections, ::Contents[i][1])
endif
next
return aSections
RETURN aSection
static procedure UpdateFile()
local Self := QSelf()
local i, j, hFile
STATIC FUNCTION ReadSections()
hFile := fcreate(::Filename)
LOCAL Self := QSelf()
LOCAL i, aSections := {}
for i := 1 to Len(::Contents)
if ::Contents[i][1] == NIL
fwrite(hFile, ::Contents[i][2] + Chr(13) + Chr(10))
FOR i := 1 TO Len( ::Contents )
elseif ValType(::Contents[i][2]) == 'A'
fwrite(hFile, '[' + ::Contents[i][1] + ']' + Chr(13) + Chr(10))
for j := 1 to Len(::Contents[i][2])
IF ValType( ::Contents[i][2] ) == "A"
AAdd( aSections, ::Contents[i][1] )
ENDIF
NEXT
RETURN aSections
STATIC PROCEDURE UpdateFile()
LOCAL Self := QSelf()
LOCAL i, j, hFile
hFile := FCreate( ::Filename )
FOR i := 1 TO Len( ::Contents )
IF ::Contents[i][1] == NIL
FWrite( hFile, ::Contents[i][2] + Chr( 13 ) + Chr( 10 ) )
ELSEIF ValType( ::Contents[i][2] ) == "A"
FWrite( hFile, "[" + ::Contents[i][1] + "]" + Chr( 13 ) + Chr( 10 ) )
FOR j := 1 TO Len( ::Contents[i][2] )
if ::Contents[i][2][j][1] == NIL
fwrite(hFile, ::Contents[i][2][j][2] + Chr(13) + Chr(10))
else
fwrite(hFile, ::Contents[i][2][j][1] + '=' + ::Contents[i][2][j][2] + Chr(13) + Chr(10))
endif
FWrite( hFile, ::Contents[i][2][j][2] + Chr( 13 ) + Chr( 10 ) )
ELSE
FWrite( hFile, ::Contents[i][2][j][1] + "=" + ::Contents[i][2][j][2] + Chr( 13 ) + Chr( 10 ) )
ENDIF
next
fwrite(hFile, Chr(13) + Chr(10))
FWrite( hFile, Chr( 13 ) + Chr( 10 ) )
elseif ValType(::Contents[i][2]) == 'C'
fwrite(hFile, ::Contents[i][1] + '=' + ::Contents[i][2] + Chr(13) + Chr(10))
ELSEIF ValType( ::Contents[i][2] ) == "C"
FWrite( hFile, ::Contents[i][1] + "=" + ::Contents[i][2] + Chr( 13 ) + Chr( 10 ) )
endif
next
fclose(hFile)
return
ENDIF
NEXT
FClose( hFile )
RETURN

194
harbour/tests/inkeytst.prg
View File

@@ -1,73 +1,77 @@
//
// $Id$
//
/*
* $Id$
*/
/* Testing Harbour keyboard input. */
// Testing Harbour keyboard input.
/* 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>
Modularization and display improvements by
Alejandro de Garate <alex_degarate@hotmail.com>
*/
#include "inkey.ch"
PROCEDURE main( cSkip, cRaw )
PROCEDURE Main( cSkip, cRaw )
ALTD(0)
AltD( 0 )
IF EMPTY( cSkip )
IF Empty( cSkip )
TEST1()
NextTest()
TEST1()
NextTest()
TEST2()
NextTest()
TEST2()
NextTest()
TEST3()
NextTest()
TEST3()
NextTest()
TEST4()
NextTest()
TEST4()
NextTest()
TEST5()
NextTest()
TEST5()
NextTest()
TEST6()
NextTest()
ENDIF
TEST6()
NextTest()
ENDIF
TEST7( cSkip, cRaw )
?
QUIT
QUIT
PROCEDURE Results()
? "Wait 2 seconds or press most any key to see the results of this test."
INKEY( 2 )
RETURN
? "Wait 2 seconds or press most any key to see the results of this test."
Inkey( 2 )
RETURN
PROCEDURE NextTest()
? "Press any key to continue on to the next test."
INKEY( 0 )
RETURN
? "Press any key to continue on to the next test."
Inkey( 0 )
RETURN
FUNCTION TEST( cText )
LOCAL cResult := ""
INKEY( 2 )
LOCAL cResult := ""
Inkey( 2 )
KEYBOARD cText
WHILE NEXTKEY() <> 0
cResult += CHR( INKEY () )
END WHILE
RETURN "'" + cResult + "'"
DO WHILE NextKey() != 0
cResult += Chr( Inkey () )
ENDDO
RETURN "'" + cResult + "'"
PROCEDURE TEST1
CLS
?
? "Testing the KEYBOARD and CLEAR TYPEAHEAD commands and the"
@@ -81,12 +85,13 @@ PROCEDURE TEST1
Results()
?
KEYBOARD "AB"
? INKEY(), INKEY()
? Inkey(), Inkey()
?
RETURN
RETURN
PROCEDURE TEST2
CLS
?
? "For the second test, the keyboard will be stuffed with the"
@@ -99,12 +104,13 @@ PROCEDURE TEST2
?
KEYBOARD "HELLO"
CLEAR TYPEAHEAD
? INKEY()
? Inkey()
?
RETURN
RETURN
PROCEDURE TEST3
CLS
?
? "For the third test, the keyboard will be stuffed with the"
@@ -116,13 +122,13 @@ PROCEDURE TEST3
Results()
?
KEYBOARD "AB"
? NEXTKEY(), NEXTKEY(), INKEY(), INKEY()
? NextKey(), NextKey(), Inkey(), Inkey()
?
RETURN
RETURN
PROCEDURE TEST4
CLS
?
? "For the fourth test, the keyboard will be stuffed with the"
@@ -135,14 +141,15 @@ PROCEDURE TEST4
Results()
?
KEYBOARD "AB"
? INKEY(), LASTKEY(), LASTKEY(), NEXTKEY(), INKEY()
? Inkey(), LastKey(), LastKey(), NextKey(), Inkey()
?
RETURN
RETURN
PROCEDURE TEST5
LOCAL cText
LOCAL cText
CLS
cText := "THIS IS A TEST. THIS IS ONLY A TEST. DO NOT PANIC!"
?? "For the fifth test, the keyboard will be stuffed with the"
@@ -152,9 +159,9 @@ LOCAL cText
? "the buffer will be emptied using NEXTKEY() and INKEY() and"
? "the ASCII text that was extracted will be displayed."
?
? "For the default size, which is 50, all but '" + RIGHT( cText, LEN( cText ) - 49 ) + "' should be"
? "displayed. For size 25, '" + LEFT( cText, 24 ) + "' should"
? "be displayed. Size 16 should display '" + LEFT( cText, 15 ) + "',"
? "For the default size, which is 50, all but '" + Right( cText, Len( cText ) - 49 ) + "' should be"
? "displayed. For size 25, '" + Left( cText, 24 ) + "' should"
? "be displayed. Size 16 should display '" + Left( cText, 15 ) + "',"
? "while size 0 should display ''."
?
? "Default TYPEAHEAD (50)"
@@ -174,26 +181,27 @@ LOCAL cText
? "SET TYPEAHEAD TO 0"
SET TYPEAHEAD TO 0
? TEST( cText )
RETURN
RETURN
PROCEDURE TEST6
CLS
CLS
? "For the sixth test"
? "The typeahead is now being set to a value greater than the maximum,"
? "which is 4096 and is the value that will both be used and reported."
? "SET TYPEAHEAD TO 5000"
?
SET TYPEAHEAD TO 5000
? SET(_SET_TYPEAHEAD)
? Set( _SET_TYPEAHEAD )
?
RETURN
RETURN
PROCEDURE TEST7( cSkip, cRaw )
LOCAL nKey, nMask, cText
LOCAL nKey, nMask, cText
CLS
? "For the last test, a loop is started and all keyboard and mouse"
? "events are allowed. Each event will be displayed. Press the TAB"
@@ -203,49 +211,49 @@ LOCAL nKey, nMask, cText
? "Press any key."
nMask := HB_INKEY_ALL
IF ! EMPTY( cRaw )
IF UPPER( LEFT( cRaw, 1 ) ) == "R"
nMask += HB_INKEY_RAW
END IF
END IF
IF ! Empty( cRaw )
IF Upper( Left( cRaw, 1 ) ) == "R"
nMask += HB_INKEY_RAW
ENDIF
ENDIF
SET(_SET_EVENTMASK, nMask)
SET( _SET_EVENTMASK, nMask )
IF ! EMPTY( cSkip )
IF UPPER( cSkip ) == "BREAK"
SETCANCEL(.T.)
ALTD(1)
tone( 440, 6 )
IF ! Empty( cSkip )
IF Upper( cSkip ) == "BREAK"
SetCancel( .T. )
AltD( 1 )
Tone( 440, 6 )
ELSE
SETCANCEL(.F.)
ALTD(0)
tone( 660, 6 )
END IF
END IF
SetCancel( .F. )
AltD( 0 )
Tone( 660, 6 )
ENDIF
ENDIF
WHILE (nKey := INKEY( 0, nMask )) != K_TAB
DO WHILE ( nKey := Inkey( 0, nMask ) ) != K_TAB
DO CASE
CASE nKey == K_MOUSEMOVE
? "The mouse moved."
CASE nKey == K_LBUTTONDOWN
? "The left mouse button was pushed."
CASE nKey == K_LBUTTONUP
? "The left mouse button was released."
CASE nKey == K_RBUTTONDOWN
? "The right mouse button was pushed."
CASE nKey == K_RBUTTONUP
? "The right mouse button was released."
CASE nKey == K_LDBLCLK
? "The left mouse button was double-clicked."
CASE nKey == K_RDBLCLK
? "The right mouse button was double-clicked."
CASE nKey == K_MOUSEMOVE
? "The mouse moved."
CASE nKey == K_LBUTTONDOWN
? "The left mouse button was pushed."
CASE nKey == K_LBUTTONUP
? "The left mouse button was released."
CASE nKey == K_RBUTTONDOWN
? "The right mouse button was pushed."
CASE nKey == K_RBUTTONUP
? "The right mouse button was released."
CASE nKey == K_LDBLCLK
? "The left mouse button was double-clicked."
CASE nKey == K_RDBLCLK
? "The right mouse button was double-clicked."
OTHERWISE
? "A keyboard key was pressed: ", nKey,;
IIF( nKey >= 32 .AND. nKey <= 255, CHR( nKey ), "" )
? "A keyboard key was pressed: ", nKey, ;
iif( nKey >= 32 .AND. nKey <= 255, Chr( nKey ), "" )
END CASE
END WHILE
? "The TAB key ("+LTRIM(STR(nKey))+") was pressed. Exiting..."
ENDDO
? "The TAB key (" + LTrim( Str( nKey ) ) + ") was pressed. Exiting..."
RETURN
RETURN

81
harbour/tests/test_all.prg
View File

@@ -1,29 +1,31 @@
//NOTEST
//
// $Id$
//
/*
* $Id$
*/
// AutoMatic Test Bank
// Patrick Mast and David G. Holm
// Compiler independent, but not platform independent (creates a DOS style batch file).
// Specify the hbxxx batch file name to use to build with on the command line.
// Defaults to "run_prg".
// The test_all.bat batch file has restart capability. For example, if there is an error
// in testgt.prg, find and fix the problem, then restart by running "TEST_ALL TESTGT".
/* AutoMatic Test Bank
Patrick Mast and David G. Holm
Compiler independent, but not platform independent (creates a DOS style batch file).
Specify the hbxxx batch file name to use to build with on the command line.
Defaults to "run_prg".
The test_all.bat batch file has restart capability. For example, if there is an error
in testgt.prg, find and fix the problem, then restart by running "TEST_ALL TESTGT".
*/
#include "directry.ch"
#include "fileio.ch"
Function Main( cOption, cCmd )
LOCAL aDir,f,n,o,p,cRead
FUNCTION Main( cOption, cCmd )
LOCAL aDir, f, n, o, p, cRead
SET DATE ANSI
SET CENTURY ON
aDir := Directory("*.prg")
o := fCreate("test_all.bat")
aDir := Directory( "*.prg" )
o := FCreate( "test_all.bat" )
IF Empty( cOption )
cOption:="run_prg"
cOption := "run_prg"
ENDIF
IF Empty( cCmd )
cCmd := "call "
@@ -31,41 +33,42 @@ Function Main( cOption, cCmd )
cCmd += " /c "
ENDIF
fWrite(o,"if not .%1==. goto %1" + Chr(13) + Chr(10))
FWrite( o, "if not .%1==. goto %1" + Chr( 13 ) + Chr( 10 ) )
FOR f := 1 TO Len(aDir)
IF TestIt(aDir[f][1])
p := At(".prg",Lower(aDir[f][1]))
FOR f := 1 TO Len( aDir )
IF TestIt( aDir[ f ][ F_NAME ] )
p := At( ".prg", Lower( aDir[ f ][ F_NAME ] ) )
IF p > 1
n := Left(aDir[f][1],p-1)
fWrite(o,":" + n + Chr(13) + Chr(10))
fWrite(o,cCmd + cOption + " " + n + Chr(13) + Chr(10);
+ "if errorlevel 1 goto end" + Chr(13) + Chr(10) + Chr(13) + Chr(10))
n := Left( aDir[ f ][ F_NAME ], p - 1 )
FWrite( o, ":" + n + Chr( 13 ) + Chr( 10 ) )
FWrite( o, cCmd + cOption + " " + n + Chr( 13 ) + Chr( 10 ) +;
"if errorlevel 1 goto end" + Chr( 13 ) + Chr( 10 ) + Chr( 13 ) + Chr( 10 ) )
ENDIF
ENDIF
NEXT
fWrite(o,":END"+Chr(13)+Chr(10))
fClose(o)
FWrite( o, ":END" + Chr( 13 ) + Chr( 10 ) )
FClose( o )
RETURN NIL
RETURN NIL
Function TestIt(cFile)
LOCAL nH1,lRetu,nH2
FUNCTION TestIt( cFile )
nH1 := fOpen(cFile)
lRetu := Upper(fReadStr(nH1,8))<>"//NOTEST"
fClose(nH1)
LOCAL nH1, lRetu, nH2
IF !lRetu
IF !File("NotTestd.txt")
nH2 := fCreate("nottestd.txt")
nH1 := FOpen( cFile )
lRetu := !( Upper( FReadStr( nH1, 8 ) ) == "//NOTEST" )
FClose( nH1 )
IF ! lRetu
IF ! hb_FileExists( "NotTestd.txt" )
nH2 := FCreate( "nottestd.txt" )
ELSE
nH2 := fOpen("nottestd.txt", FO_WRITE)
nH2 := FOpen( "nottestd.txt", FO_WRITE )
ENDIF
fSeek(nH2, 0, FS_END)
fWrite(nH2,DtoC(Date())+" "+Time()+" "+cFile+Chr(13)+Chr(10))
fClose(nH2)
FSeek( nH2, 0, FS_END )
FWrite( nH2, DToC( Date() ) + " " + Time() + " " + cFile + Chr( 13 ) + Chr( 10 ) )
FClose( nH2 )
ENDIF
RETURN lRetu
RETURN lRetu