OFF TOPIC: OOP on HMG

[José Quintas]

Only testing possibilities of OOP over old style _HMG_SYSDATA

I do not know about speed, compatibility and others, including do not validate parameters

/*
h_HmgApp
*/

#include "hbclass.ch"

MEMVAR _HMG_SYSDATA

THREAD STATIC oApp

INIT PROCEDURE Init_oApp

   oApp := _hmg_AppClass():New()

   RETURN

CREATE CLASS _Hmg_AppClass

   VAR aList INIT {}
   METHOD AddItem( xValue )
   METHOD GetItemFromName( xValue )
   METHOD GetItemFromHandle( xValue )
   METHOD DelItem( xValue )

   ENDCLASS

METHOD AddItem( xValue ) CLASS _Hmg_AppClass

   LOCAL oObj, nIndex

   oObj := _hmg_ObjClass():New()
   oObj:Name := xValue
   oObj:Index := 0 // index on _HMG_SYSDATA
   AAdd( ::aList, oObj )

   RETURN oObj

METHOD GetItemFromName( xValue ) CLASS _hmg_AppClass

   LOCAL nIndex

   nIndex := hb_ASCan( ::aList, { | e | e:Name == xValue } )
   IF nIndex != 0
      RETURN ::aList[ nIndex ]
   ENDIF

   RETURN Nil

METHOD GetItemFromHandle( xValue ) CLASS _hmg_AppClass

   LOCAL nIndex

   nIndex := hb_ASCan( ::aList, { | e | e:Handle == xValue } )
   IF nIndex != 0
      RETURN ::aList[ nIndex ]
   ENDIF

   RETURN Nil

METHOD DelItem( xValue ) CLASS _hmg_AppClass

   LOCAL nIndex

   nIndex := hb_ASCan( ::aList, { | e | e:Name == xValue } )
   IF nIndex == 0 .OR. ValType( ::aList[ nIndex ] ) != "O"
      MsgInfo( "Can't remove " + xValue )
   ELSE
      ::aList[ nIndex ]:Destroy()
   ENDIF

   RETURN Nil

CREATE CLASS _hmg_ObjClass

   VAR _nIndex  INIT 0

   METHOD SetGet( xKey, xValue )
   METHOD Destroy() INLINE Nil
   METHOD Index( xValue )  INLINE ::SetGet( @::_nIndex, xValue )
   METHOD Name( xValue )   INLINE ::SetGet( @_HMG_SYSDATA[ 66, ::_nIndex ], xValue )
   METHOD Handle( xValue ) INLINE ::SetGet( @_HMG_SYSDATA[ 67, ::_nIndex ], xValue )
   METHOD Type( xValue )   INLINE ::SetGet( @_HMG_SYSDATA[ 69, ::_nIndex ], xValue )

   ENDCLASS

METHOD SetGet( xKey, xValue ) CLASS _hmg_ObjClass

   IF xValue != Nil
      xKey := xValue
   ENDIF

   RETURN xKey

José M. C. Quintas

[José Quintas]

Applying over HMG3.

Changing all code to object, object is a wrapper, and allways compatible.

It will be a long time to do the end.

José M. C. Quintas

[José Quintas]

hmgforum.com is not accessible from Brazil, except by proxy.

Can't register there.

workbegin:

15.976 _hmg_sysdata on source code

_hmg_sysdata size 518

current:

3024 _hmg_sysdata on source code

_hmg_sysdata size 73 (do not test with size 40)

source code = PRG, CH, IDE

Remaing array about controls, working in compatible mode until the end.
It will be a long time until the end.

On my few tests, it is working ok (bugs about changes solved)

José M. C. Quintas

[José Quintas]

Current _HMG_SYSDATA with ZERO SIZE.

_HMG_SYSDATA values are now on AppClass, FormClass and ControlClass

There are 145 _hmg_sysdata on source code to solve, on IDE and on grid/grid_ex.

DLGAUTO working with this changed version.

To help on changes:

REQUEST HB_CODEPAGE_PTISO

#include "inkey.ch"
#include "set.ch"
#include "directry.ch"

PROCEDURE Main

   SetMode(33,100)
   CLS
   Set( _SET_CODEPAGE, "PTISO" )

   ProcDir( "d:\github\hmg3\" )
   ? "End"

   Inkey(0)

   RETURN

STATIC FUNCTION ProcDir( cPath )

   LOCAL aFileList, aFile, cFileName

   aFileList := Directory( cPath + "*.*", "D" )
   FOR EACH aFile IN aFileList
      IF "D" $ aFile[ F_ATTR ]
         IF aFile[ F_NAME ] == "." .OR. aFile[ F_NAME ] == ".."
         ELSE
            ProcDir( cPath + aFile[ F_NAME ] + "\" )
         ENDIF
      ELSE
         cFileName := cPath + aFile[ F_NAME ]
         IF Upper( Right( cFileName, 4 ) ) == ".PRG" .OR. ;
            Upper( Right( cFileName, 3 ) ) == ".CH"
            ChangeText( cFileName )
         ENDIF
      ENDIF
   NEXT

   RETURN Nil

STATIC FUNCTION ChangeText( cFile )

   LOCAL cText, cTextOld, nIndex, lNoChange, cFrom, cTo
   LOCAL nSpace1, nSpace2, nSpace3, nSpace4, nSpace5, nSpace6
   LOCAL aTroca := { "B", "&" + "mVar", "nIdx", "nIndex", "niControl", ;
      "niTab", "index", "p", "I", "x1", "tabindex", "x", "w", "i", ;
      "k", "j", "idx", "xx", "ix" }
   LOCAL aSysData := { "_HMG_SYSDATA", "_hmg_sysdata" }
   LOCAL cChave, cTxtData

   ? Time() + " " + cFile
   cText := MemoRead( cFile )
   cTextOld := cText

   cText := StrTran( cText, Chr(9), Space(3) )
   FOR EACH cChave IN aTroca
      FOR nSpace4 = 1 TO 1 // 10
         FOR nSpace6 = 0 TO 0
            FOR nSpace1 = 1 TO 1
               FOR nSpace2 = 0 TO 0
                  FOR nSpace3 = 0 TO 0
                     FOR nSpace5 = 0 TO 0
                        FOR EACH cTxtData IN aSysData
                           FOR nIndex = 1 TO 41
                              cTo := "ControlByIndex( " + Upper( cChave ) + " ):CTRL" + StrZero( nIndex, 3 )
                              cFrom := ;
                                 cTxtData + Space(nSpace1) + ;
                                 "[" + Space(nSpace2) + ;
                                 Ltrim( Str( nIndex ) ) + Space(nSpace3) + ;
                                 "]" + Space(nSpace4) + ;
                                 "[" + Space(nSpace5) + ;
                                 cChave + Space(nSpace6) + ;
                                 "]"
                              IF cFrom $ cText
                                 ? "found from " + cFrom
                                 cText := StrTran( cText, cFrom, cTo )
                                 hb_MemoWrit( cFile, cText )
                              ENDIF
                           NEXT
                        NEXT
                     NEXT
                  NEXT
               NEXT
            NEXT
         NEXT
      NEXT
   NEXT
   //cText := StrTran( cText, ":CTRL001", ":Type" )
   //cText := StrTran( cText, ":CTRL002", ":Name" )
   //cText := StrTran( cText, ":CTRL003", ":Handle" )
   //cText := StrTran( cText, ":CTRL004", ":ParentFormHandle" )
   //cText := StrTran( cText, ":CTRL013", ":IsDeleted" )

   lNoChange := ( cText == cTextOld )
   IF ! lNoChange
      ? Pad( iif( lNoChange, "", "Yes" ), 5 ) + cFile
      hb_MemoWrit( cFile, cText )
   ENDIF

   RETURN Nil

José M. C. Quintas