FiveTech Software tech support forums

www.FiveTechSoft.com
https://fivetechsupport.com/forums/

Nueva utilidad REDEFINE.prg libre

https://fivetechsupport.com/forums/viewtopic.php?f=6&t=28863

Page 2 of 3

Re: Nueva utilidad REDEFINE.prg libre

PostPosted: Mon Jul 14, 2014 6:17 pm
by devtuxtla
Hola Antonio.

Excelente herramienta.

Pregunta: es posible que el archivo de recursos sea un .res ?

Saludos

Re: Nueva utilidad REDEFINE.prg libre

PostPosted: Mon Jul 14, 2014 7:04 pm
by lucasdebeltran
Antonio,

Podría ser por ejemplo:

cIDControl := "oGet[" + chr(34) + AllTrim( Str( ++nGet ) + chr(34) +"]"


y quedaría el GET en el .prg:

REDEFINE GET oGet["1"] VAR etc etc


y así, por ejemplo, en el código se puede manipular así:

oGet["1"]:SetFocus()

oGet["PRECIO"]:SetFocus()



etc

Re: Nueva utilidad REDEFINE.prg libre

PostPosted: Mon Jul 14, 2014 9:42 pm
by Antonio Linares
Lucas,

De esa forma oGet ya no sería un objeto TGet sino un hash y eso es confuso.

No veo una gran ventaja en lo que indicas, de todas formas, ahí estan los fuentes y lo puedes modificar para ti como mejor te sirva :-)

Re: Nueva utilidad REDEFINE.prg libre

PostPosted: Mon Jul 14, 2014 9:56 pm
by Antonio Linares
Biel,

He estado revisando lo que comentas de PellesC, y se debe a que ambos formatos son soportados por Windows.

En esta nueva versión, ya se procesan correctamente los GETs de PellesC tambien. Asi podemos extenderlo a los otros controles tambien :-)

redefine.prg
Code: Select all  Expand view
// Automatic REDEFINEs generator

#include "FiveWin.ch"

static cRCSrcCode, aDialogs := {}

//----------------------------------------------------------------------------//

function Main()

   local oDlg, oGet, cRCFileName := Space( 250 )
   local oLbx, cDlgName := Space( 50 ), oMemoRC, cCode := ""
   local oFont, oMemoPrg, cPrg := ""

   SetDlgGradient( { { 1, RGB( 199, 216, 237 ), RGB( 237, 242, 248 ) } } )
   
   DEFINE FONT oFont NAME "Courier New" SIZE 0, -14
   
   DEFINE DIALOG oDlg TITLE "RCs REDEFINEs builder" ;
      SIZE 900, 700

   @ 0.7, 1.5 SAY "RC filename:" OF oDlg SIZE 80, 9
   
   @ 0.8, 6 GET oGet VAR cRCFileName OF oDlg SIZE 200, 12 ;
      ACTION ( cRCFileName := cGetFile( "*.rc", "Please select a RC file" ),;
               oGet:oBtn:Refresh(), oGet:SetFocus(),;
               aDialogs := {}, ListDialogs( cRCFileName, oLbx ) )

   @ 2, 1.5 SAY "Dialogs in the RC file:" OF oDlg SIZE 80, 9

   @ 3, 1 LISTBOX oLbx VAR cDlgName ITEMS {} OF oDlg SIZE 80, 164 ;
      ON CHANGE ShowCode( cDlgName, oMemoRC, oMemoPrg )

   @ 2, 16.4 SAY "RC dialog source:" OF oDlg SIZE 80, 9

   @ 3.3, 12 GET oMemoRC VAR cCode MEMO OF oDlg SIZE 345, 157 ;
      FONT oFont HSCROLL

   @ 16, 1 GET oMemoPrg VAR cPrg MEMO OF oDlg SIZE 433, 135 ;
      FONT oFont HSCROLL

   ACTIVATE DIALOG oDlg CENTERED

   oFont:End()

return nil

//----------------------------------------------------------------------------//

function ListDialogs( cRCFileName, oLbx )

   local n, cDlgName, lDone, cLine

   if ! File( cRCFileName )
      MsgAlert( cRCFileName + " does not exist" )
      return nil
   endif  
   
   cRCSrcCode = MemoRead( cRCFileName )
   oLbx:Reset()
   
   for n = 1 to MLCount( cRCSrcCode )
      cLine = MemoLine( cRCSrcCode,, n )
      SysRefresh()
      if ! SubStr( cLine, 1, 2 ) $ "//,/*"
         if Upper( StrToken( MemoLine( cRCSrcCode,, n ), 2 ) ) $ "DIALOGEX"
            oLbx:Add( cDlgName := StrToken( MemoLine( cRCSrcCode,, n ), 1 ) )
            AAdd( aDialogs, { cDlgName, { cLine } } )
            lDone = .F.
         else
            if ! Empty( aDialogs )
               if Len( AllTrim( cLine ) ) == 1 .and. SubStr( cLine, 1, 1 ) == "}"
                  AAdd( ATail( aDialogs )[ 2 ], "}" )  
                  lDone = .T.
               else  
                  if ! lDone
                     AAdd( ATail( aDialogs )[ 2 ], cLine )  
                  endif  
               endif  
            endif  
         endif
      endif  
   next
   
   oLbx:GoTop()
   
return nil        

//----------------------------------------------------------------------------//

function ShowCode( cDlgName, oMemoRC, oMemoPrg )

   local nAt := AScan( aDialogs, { | aDlg | aDlg[ 1 ] == cDlgName } )
   
   if nAt != 0
      oMemoRC:SetText( ArrayToText( aDialogs[ nAt ][ 2 ] ) )
      oMemoPrg:SetText( RcToPrg( cDlgName, aDialogs[ nAt ][ 2 ] ) )
   endif  
   
return nil  

//----------------------------------------------------------------------------//

function ArrayToText( aArray )

   local n, cText := ""
   
   for n = 1 to Len( aArray )
      cText += aArray[ n ] + CRLF
   next
   
return cText

//----------------------------------------------------------------------------//

function RcToPrg( cDlgName, aRCSource )

   local cFuncName := "function " + cDlgName + "()" + CRLF + CRLF
   local n, cCode := "", aTokens, cToken
   local nSay := 0, nGet := 0, nBtn := 0, nLbx := 0
   local cVarsSays := "   local "
   local cVarsGets := "   local "
   local cVarsButtons := "   local "
   local cVarsLbxs := "   local "
   local cDlgDefine := "   DEFINE DIALOG oDlg RESOURCE " + '"' + ;
                       cDlgName + '"'
   local cId                  
   local cDlgActivate := "   ACTIVATE DIALOG oDlg CENTERED" + CRLF + CRLF
   
   for n = 1 to Len( aRCSource )
      aTokens = hb_ATokens( aRCSource[ n ] )
      cToken = AllTrim( aTokens[ 1 ] )
      // XBrowser aTokens
      do case
         case cToken == "EDITTEXT" .or. ;
              ( cToken == "CONTROL" .and. aTokens[ 2 ] == '"Edit",' )
            if cToken == "EDITTEXT"  
               cId = AllTrim( StrTran( aTokens[ 2 ], ",", "" ) )
            else  
               cId = AllTrim( StrToken( aRCSource[ n ], 2, "," ) )
            endif  
            cCode += "   REDEFINE GET oGet" + AllTrim( Str( ++nGet ) ) + ;
                     " ID " + cId + " OF oDlg" + CRLF + CRLF
            cVarsGets += "oGet" + AllTrim( Str( nGet ) ) + ", "      

         case cToken == "LISTBOX"
            cId = AllTrim( StrTran( aTokens[ 2 ], ",", "" ) )
            cCode += "   REDEFINE LISTBOX oLbx" + AllTrim( Str( ++nLbx ) ) + ;
                     " ITEMS {}" + ;
                     " ID " + cId + " OF oDlg" + CRLF + CRLF
            cVarsLbxs += "oLbx" + AllTrim( Str( nLbx ) ) + ", "      
                     
         case cToken == "LTEXT"
            cId = AllTrim( StrToken( aRCSource[ n ], 2, ',' ) )
            if ! cId $ "0,-1" // We don't redefine 0 and -1 IDs
               cCode += "   REDEFINE SAY oSay" + AllTrim( Str( ++nSay ) ) + ;
                        " ID " + cId + " OF oDlg" + " // " + ;
                        StrTran( aTokens[ 2 ], ",", "" ) + CRLF + CRLF
               cVarsSays += "oSay" + AllTrim( Str( nSay ) ) + ", "      
            endif  

         case cToken == "PUSHBUTTON"
            cId = AllTrim( StrToken( aRcSource[ n ], 2, ',' ) )
            cCode += "   REDEFINE BUTTON oBtn" + AllTrim( Str( ++nBtn ) ) + ;
                     " ID " + cId + " OF oDlg ; // " + ;
                     '"' + StrToken( aRcSource[ n ], 2, '"' ) + '"' + CRLF + ;
                     "      ACTION MsgInfo( " + ;
                     '"' + StrToken( aRcSource[ n ], 2, '"' ) + '"' + " )" + ;
                     CRLF + CRLF
            cVarsButtons += "oBtn" + AllTrim( Str( nBtn ) ) + ", "      
      endcase
     
   next
   
   if Len( cVarsSays ) > Len( "   local " )
      cVarsSays = SubStr( cVarsSays, 1, Len( cVarsSays ) - 2 )
   else
      cVarsSays = ""
   endif
   
   if Len( cVarsGets ) > Len( "   local " )      
      cVarsGets = SubStr( cVarsGets, 1, Len( cVarsGets ) - 2 )
   else
      cVarsGets = ""
   endif
   
   if Len( cVarsButtons ) > Len( "   local " )
      cVarsButtons = SubStr( cVarsButtons, 1, Len( cVarsButtons ) - 2 )
   else  
      cVarsButtons = ""
   endif

   if Len( cVarsLbxs ) > Len( "   local " )
      cVarsLbxs = SubStr( cVarsLbxs, 1, Len( cVarsLbxs ) - 2 )
   else  
      cVarsLbxs = ""
   endif
         
return cFuncName + ;
       "   local oDlg" + CRLF + ;
       If( ! Empty( cVarsSays ), cVarsSays + CRLF, "" ) + ;
       If( ! Empty( cVarsGets ), cVarsGets + CRLF, "" ) + ;
       If( ! Empty( cVarsButtons ), cVarsButtons + CRLF, "" ) + ;
       If( ! Empty( cVarsLbxs ), cVarsLbxs + CRLF, "" ) + ;
       If( ! Empty( cVarsSays ) .or. ! Empty( cVarsGets ) .or. ;
           ! Empty( cVarsButtons ) .or. ! Empty( cVarsLbxs ), CRLF, "" ) + ;
       If( Empty( cVarsSays ) .and. Empty( cVarsGets ) .and. ;
           Empty( cVarsButtons ) .and. Empty( cVarsLbxs ),;
       CRLF, "" ) + cDlgDefine + CRLF + ;
       CRLF + cCode + ;
       cDlgActivate + "return nil"            
       
//----------------------------------------------------------------------------//      

Re: Nueva utilidad REDEFINE.prg libre

PostPosted: Mon Jul 14, 2014 10:04 pm
by csincuir
Antonio,
He agregado el soporte para "CheckBox", si te parece bien, para que lo puedas agregar.

Los cabios estan marcados con: // <------CAMBIOS

Saludos.

Carlos.

Code: Select all  Expand view

//----------------------------------------------------------------------------//

function RcToPrg( cDlgName, aRCSource )

   local cFuncName := "function " + cDlgName + "()" + CRLF + CRLF
   local n, cCode := "", aTokens, cToken
   local nSay := 0, nGet := 0, nBtn := 0, nLbx := 0, nChec := 0  //  <------CAMBIOS
   local cVarsSays := "   local "
   local cVarsGets := "   local "
   local cVarsButtons := "   local "
   local cVarsLbxs := "   local "
   local cVarsCheckBox := "   local "
   local cDlgDefine := "   DEFINE DIALOG oDlg RESOURCE " + '"' + ;
                       cDlgName + '"'
   local cId                  
   local cDlgActivate := "   ACTIVATE DIALOG oDlg CENTERED" + CRLF + CRLF
   
   for n = 1 to Len( aRCSource )
      aTokens = hb_ATokens( aRCSource[ n ] )
      cToken = AllTrim( aTokens[ 1 ] )
      do case
         case cToken == "EDITTEXT"
            cId = AllTrim( StrTran( aTokens[ 2 ], ",", "" ) )
            cCode += "   REDEFINE GET oGet" + AllTrim( Str( ++nGet ) ) + ;
                     " ID " + cId + " OF oDlg" + CRLF + CRLF
            cVarsGets += "oGet" + AllTrim( Str( nGet ) ) + ", "      

         case cToken == "LISTBOX"
            cId = AllTrim( StrTran( aTokens[ 2 ], ",", "" ) )
            cCode += "   REDEFINE LISTBOX oLbx" + AllTrim( Str( ++nLbx ) ) + ;
                     " ITEMS {}" + ;
                     " ID " + cId + " OF oDlg" + CRLF + CRLF
            cVarsLbxs += "oLbx" + AllTrim( Str( nLbx ) ) + ", "      
                     
         case cToken == "LTEXT"
            cId = AllTrim( StrToken( aRCSource[ n ], 2, ',' ) )
            if ! cId $ "0,-1" // We don't redefine 0 and -1 IDs
               cCode += "   REDEFINE SAY oSay" + AllTrim( Str( ++nSay ) ) + ;
                        " ID " + cId + " OF oDlg" + " // " + ;
                        StrTran( aTokens[ 2 ], ",", "" ) + CRLF + CRLF
               cVarsSays += "oSay" + AllTrim( Str( nSay ) ) + ", "      
            endif  

         case cToken == "AUTOCHECKBOX" .OR. cToken == "CHECKBOX"   //  <------CAMBIOS
            cId = AllTrim( StrToken( aRcSource[ n ], 2, ',' ) )
            cCode += "   REDEFINE CHECKBOX oCheck" + AllTrim( Str( ++nChec ) ) + ;
                     " ID " + cId + " OF oDlg // " + ;
                     '"' + StrToken( aRcSource[ n ], 2, '"' ) + '"' + CRLF + ;
                     CRLF
            cVarsCheckBox += "oCheck" + AllTrim( Str( nChec ) ) + ", "      //  <------CAMBIOS
           
         case cToken == "PUSHBUTTON"
            cId = AllTrim( StrToken( aRcSource[ n ], 2, ',' ) )
            cCode += "   REDEFINE BUTTON oBtn" + AllTrim( Str( ++nBtn ) ) + ;
                     " ID " + cId + " OF oDlg ; // " + ;
                     '"' + StrToken( aRcSource[ n ], 2, '"' ) + '"' + CRLF + ;
                     "      ACTION MsgInfo( " + ;
                     '"' + StrToken( aRcSource[ n ], 2, '"' ) + '"' + " )" + ;
                     CRLF + CRLF
            cVarsButtons += "oBtn" + AllTrim( Str( nBtn ) ) + ", "      
           
      endcase
     
   next
   
   if Len( cVarsSays ) > Len( "   local " )
      cVarsSays = SubStr( cVarsSays, 1, Len( cVarsSays ) - 2 )
   else
      cVarsSays = ""
   endif
   
   if Len( cVarsGets ) > Len( "   local " )      
      cVarsGets = SubStr( cVarsGets, 1, Len( cVarsGets ) - 2 )
   else
      cVarsGets = ""
   endif
   
   if Len( cVarsButtons ) > Len( "   local " )
      cVarsButtons = SubStr( cVarsButtons, 1, Len( cVarsButtons ) - 2 )
   else  
      cVarsButtons = ""
   endif

   if Len( cVarsLbxs ) > Len( "   local " )
      cVarsLbxs = SubStr( cVarsLbxs, 1, Len( cVarsLbxs ) - 2 )
   else  
      cVarsLbxs = ""
   endif
         
return cFuncName + ;
       "   local oDlg" + CRLF + ;
       If( ! Empty( cVarsCheckBox ), cVarsCheckBox + CRLF, "" ) + ;   //  <------CAMBIOS
       If( ! Empty( cVarsSays ), cVarsSays + CRLF, "" ) + ;
       If( ! Empty( cVarsGets ), cVarsGets + CRLF, "" ) + ;
       If( ! Empty( cVarsButtons ), cVarsButtons + CRLF, "" ) + ;
       If( ! Empty( cVarsLbxs ), cVarsLbxs + CRLF, "" ) + ;
       If( ! Empty( cVarsSays ) .or. ! Empty( cVarsGets ) .or. ;
           ! Empty( cVarsButtons ) .or. ! Empty( cVarsLbxs ), CRLF, "" ) + ;
       If( Empty( cVarsSays ) .and. Empty( cVarsGets ) .and. ;
           Empty( cVarsButtons ) .and. Empty( cVarsLbxs ),;
       CRLF, "" ) + cDlgDefine + CRLF + ;
       CRLF + cCode + ;
       cDlgActivate + "return nil"            
 

Re: Nueva utilidad REDEFINE.prg libre

PostPosted: Mon Jul 14, 2014 10:09 pm
by Antonio Linares
Joao,

Esta nueva versión ya no usa MemoLine() sino la Clase TTxtFile() de FWH, verás como corre ahora :-)

El soporte de PellesC estaba mal en la versión anterior. Ahora ya procesa bien los GETs de PellesC.

Biel, el ejemplo de RC tuyo lo procesa bien. Falta implementar esos cambios en los demás controles.

Carlos, podrias añadir a esta versión tus cambios y lo publicas entero ? gracias :-)

redefine.prg
Code: Select all  Expand view
// Automatic REDEFINEs generator

#include "FiveWin.ch"

static cRCSrcCode, aDialogs := {}

//----------------------------------------------------------------------------//

function Main()

   local oDlg, oGet, cRCFileName := Space( 250 )
   local oLbx, cDlgName := Space( 50 ), oMemoRC, cCode := ""
   local oFont, oMemoPrg, cPrg := ""

   SetDlgGradient( { { 1, RGB( 199, 216, 237 ), RGB( 237, 242, 248 ) } } )
   
   DEFINE FONT oFont NAME "Courier New" SIZE 0, -14
   
   DEFINE DIALOG oDlg TITLE "RCs REDEFINEs builder" ;
      SIZE 900, 700

   @ 0.7, 1.5 SAY "RC filename:" OF oDlg SIZE 80, 9
   
   @ 0.8, 6 GET oGet VAR cRCFileName OF oDlg SIZE 200, 12 ;
      ACTION ( cRCFileName := cGetFile( "*.rc", "Please select a RC file" ),;
               oGet:oBtn:Refresh(), oGet:SetFocus(),;
               aDialogs := {}, ListDialogs( cRCFileName, oLbx ) )

   @ 2, 1.5 SAY "Dialogs in the RC file:" OF oDlg SIZE 80, 9

   @ 3, 1 LISTBOX oLbx VAR cDlgName ITEMS {} OF oDlg SIZE 80, 164 ;
      ON CHANGE ShowCode( cDlgName, oMemoRC, oMemoPrg )

   @ 2, 16.4 SAY "RC dialog source:" OF oDlg SIZE 80, 9

   @ 3.3, 12 GET oMemoRC VAR cCode MEMO OF oDlg SIZE 345, 157 ;
      FONT oFont HSCROLL

   @ 16, 1 GET oMemoPrg VAR cPrg MEMO OF oDlg SIZE 433, 135 ;
      FONT oFont HSCROLL

   ACTIVATE DIALOG oDlg CENTERED

   oFont:End()

return nil

//----------------------------------------------------------------------------//

function ListDialogs( cRCFileName, oLbx )

   local n, cDlgName, lDone, cLine, oRCFile

   if ! File( cRCFileName )
      MsgAlert( cRCFileName + " does not exist" )
      return nil
   endif  
   
   // cRCSrcCode = MemoRead( cRCFileName )
   oRCFile = TTxtFile():New( cRCFileName )
   oLbx:Reset()
   
   for n = 1 to oRCFile:RecCount() // MLCount( cRCSrcCode )
      cLine = oRCFile:ReadLine() // MemoLine( cRCSrcCode,, n )
      oRcFile:Skip()
      SysRefresh()
      if ! SubStr( cLine, 1, 2 ) $ "//,/*"
         if Upper( StrToken( cLine, 2 ) ) $ "DIALOGEX"
            oLbx:Add( cDlgName := StrToken( cLine, 1 ) )
            AAdd( aDialogs, { cDlgName, { cLine } } )
            lDone = .F.
         else
            if ! Empty( aDialogs )
               if Len( AllTrim( cLine ) ) == 1 .and. SubStr( cLine, 1, 1 ) == "}"
                  AAdd( ATail( aDialogs )[ 2 ], "}" )  
                  lDone = .T.
               else  
                  if ! lDone
                     AAdd( ATail( aDialogs )[ 2 ], cLine )  
                  endif  
               endif  
            endif  
         endif
      endif  
   next
   
   oLbx:GoTop()
   
return nil        

//----------------------------------------------------------------------------//

function ShowCode( cDlgName, oMemoRC, oMemoPrg )

   local nAt := AScan( aDialogs, { | aDlg | aDlg[ 1 ] == cDlgName } )
   
   if nAt != 0
      oMemoRC:SetText( ArrayToText( aDialogs[ nAt ][ 2 ] ) )
      oMemoPrg:SetText( RcToPrg( cDlgName, aDialogs[ nAt ][ 2 ] ) )
   endif  
   
return nil  

//----------------------------------------------------------------------------//

function ArrayToText( aArray )

   local n, cText := ""
   
   for n = 1 to Len( aArray )
      cText += aArray[ n ] + CRLF
   next
   
return cText

//----------------------------------------------------------------------------//

function RcToPrg( cDlgName, aRCSource )

   local cFuncName := "function " + cDlgName + "()" + CRLF + CRLF
   local n, cCode := "", aTokens, cToken
   local nSay := 0, nGet := 0, nBtn := 0, nLbx := 0
   local cVarsSays := "   local "
   local cVarsGets := "   local "
   local cVarsButtons := "   local "
   local cVarsLbxs := "   local "
   local cDlgDefine := "   DEFINE DIALOG oDlg RESOURCE " + '"' + ;
                       cDlgName + '"'
   local cId                  
   local cDlgActivate := "   ACTIVATE DIALOG oDlg CENTERED" + CRLF + CRLF
   
   for n = 1 to Len( aRCSource )
      aTokens = hb_ATokens( aRCSource[ n ] )
      cToken = AllTrim( aTokens[ 1 ] )
      // XBrowser aTokens
      do case
         case cToken == "EDITTEXT" .or. ;
              ( cToken == "CONTROL" .and. Upper( aTokens[ 4 ] ) == '"EDIT",' )
            if cToken == "EDITTEXT"  
               cId = AllTrim( StrTran( aTokens[ 2 ], ",", "" ) )
            else  
               cId = AllTrim( StrToken( aRCSource[ n ], 2, "," ) )
            endif  
            cCode += "   REDEFINE GET oGet" + AllTrim( Str( ++nGet ) ) + ;
                     " ID " + cId + " OF oDlg" + CRLF + CRLF
            cVarsGets += "oGet" + AllTrim( Str( nGet ) ) + ", "      

         case cToken == "LISTBOX"
            cId = AllTrim( StrTran( aTokens[ 2 ], ",", "" ) )
            cCode += "   REDEFINE LISTBOX oLbx" + AllTrim( Str( ++nLbx ) ) + ;
                     " ITEMS {}" + ;
                     " ID " + cId + " OF oDlg" + CRLF + CRLF
            cVarsLbxs += "oLbx" + AllTrim( Str( nLbx ) ) + ", "      
                     
         case cToken == "LTEXT"
            cId = AllTrim( StrToken( aRCSource[ n ], 2, ',' ) )
            if ! cId $ "0,-1" // We don't redefine 0 and -1 IDs
               cCode += "   REDEFINE SAY oSay" + AllTrim( Str( ++nSay ) ) + ;
                        " ID " + cId + " OF oDlg" + " // " + ;
                        StrTran( aTokens[ 2 ], ",", "" ) + CRLF + CRLF
               cVarsSays += "oSay" + AllTrim( Str( nSay ) ) + ", "      
            endif  

         case cToken == "PUSHBUTTON"
            cId = AllTrim( StrToken( aRcSource[ n ], 2, ',' ) )
            cCode += "   REDEFINE BUTTON oBtn" + AllTrim( Str( ++nBtn ) ) + ;
                     " ID " + cId + " OF oDlg ; // " + ;
                     '"' + StrToken( aRcSource[ n ], 2, '"' ) + '"' + CRLF + ;
                     "      ACTION MsgInfo( " + ;
                     '"' + StrToken( aRcSource[ n ], 2, '"' ) + '"' + " )" + ;
                     CRLF + CRLF
            cVarsButtons += "oBtn" + AllTrim( Str( nBtn ) ) + ", "      
      endcase
     
   next
   
   if Len( cVarsSays ) > Len( "   local " )
      cVarsSays = SubStr( cVarsSays, 1, Len( cVarsSays ) - 2 )
   else
      cVarsSays = ""
   endif
   
   if Len( cVarsGets ) > Len( "   local " )      
      cVarsGets = SubStr( cVarsGets, 1, Len( cVarsGets ) - 2 )
   else
      cVarsGets = ""
   endif
   
   if Len( cVarsButtons ) > Len( "   local " )
      cVarsButtons = SubStr( cVarsButtons, 1, Len( cVarsButtons ) - 2 )
   else  
      cVarsButtons = ""
   endif

   if Len( cVarsLbxs ) > Len( "   local " )
      cVarsLbxs = SubStr( cVarsLbxs, 1, Len( cVarsLbxs ) - 2 )
   else  
      cVarsLbxs = ""
   endif
         
return cFuncName + ;
       "   local oDlg" + CRLF + ;
       If( ! Empty( cVarsSays ), cVarsSays + CRLF, "" ) + ;
       If( ! Empty( cVarsGets ), cVarsGets + CRLF, "" ) + ;
       If( ! Empty( cVarsButtons ), cVarsButtons + CRLF, "" ) + ;
       If( ! Empty( cVarsLbxs ), cVarsLbxs + CRLF, "" ) + ;
       If( ! Empty( cVarsSays ) .or. ! Empty( cVarsGets ) .or. ;
           ! Empty( cVarsButtons ) .or. ! Empty( cVarsLbxs ), CRLF, "" ) + ;
       If( Empty( cVarsSays ) .and. Empty( cVarsGets ) .and. ;
           Empty( cVarsButtons ) .and. Empty( cVarsLbxs ),;
       CRLF, "" ) + cDlgDefine + CRLF + ;
       CRLF + cCode + ;
       cDlgActivate + "return nil"            
       
//----------------------------------------------------------------------------//      

Re: Nueva utilidad REDEFINE.prg libre

PostPosted: Mon Jul 14, 2014 10:10 pm
by Antonio Linares
Carlos,

Por favor, en vez de nChec, usa nChk, gracias

Re: Nueva utilidad REDEFINE.prg libre

PostPosted: Mon Jul 14, 2014 10:16 pm
by csincuir
Listo Antonio.
Ya lo he probado, y ahora corre muchisimo mas rapido en la lectura de los RC.

Saludos.

Carlos.

Code: Select all  Expand view

// Automatic REDEFINEs generator

#include "FiveWin.ch"

static cRCSrcCode, aDialogs := {}

//----------------------------------------------------------------------------//

function Main()

   local oDlg, oGet, cRCFileName := Space( 250 )
   local oLbx, cDlgName := Space( 50 ), oMemoRC, cCode := ""
   local oFont, oMemoPrg, cPrg := ""

   SetDlgGradient( { { 1, RGB( 199, 216, 237 ), RGB( 237, 242, 248 ) } } )
   
   DEFINE FONT oFont NAME "Courier New" SIZE 0, -14
   
   DEFINE DIALOG oDlg TITLE "RCs REDEFINEs builder" ;
      SIZE 900, 700

   @ 0.7, 1.5 SAY "RC filename:" OF oDlg SIZE 80, 9
   
   @ 0.8, 6 GET oGet VAR cRCFileName OF oDlg SIZE 200, 12 ;
      ACTION ( cRCFileName := cGetFile( "*.rc", "Please select a RC file" ),;
               oGet:oBtn:Refresh(), oGet:SetFocus(),;
               aDialogs := {}, ListDialogs( cRCFileName, oLbx ) )

   @ 2, 1.5 SAY "Dialogs in the RC file:" OF oDlg SIZE 80, 9

   @ 3, 1 LISTBOX oLbx VAR cDlgName ITEMS {} OF oDlg SIZE 80, 164 ;
      ON CHANGE ShowCode( cDlgName, oMemoRC, oMemoPrg )

   @ 2, 16.4 SAY "RC dialog source:" OF oDlg SIZE 80, 9

   @ 3.3, 12 GET oMemoRC VAR cCode MEMO OF oDlg SIZE 345, 157 ;
      FONT oFont HSCROLL

   @ 16, 1 GET oMemoPrg VAR cPrg MEMO OF oDlg SIZE 433, 135 ;
      FONT oFont HSCROLL

   ACTIVATE DIALOG oDlg CENTERED

   oFont:End()

return nil

//----------------------------------------------------------------------------//

function ListDialogs( cRCFileName, oLbx )

   local n, cDlgName, lDone, cLine, oRCFile

   if ! File( cRCFileName )
      MsgAlert( cRCFileName + " does not exist" )
      return nil
   endif  
   
   // cRCSrcCode = MemoRead( cRCFileName )
   oRCFile = TTxtFile():New( cRCFileName )
   oLbx:Reset()
   
   for n = 1 to oRCFile:RecCount() // MLCount( cRCSrcCode )
      cLine = oRCFile:ReadLine() // MemoLine( cRCSrcCode,, n )
      oRcFile:Skip()
      SysRefresh()
      if ! SubStr( cLine, 1, 2 ) $ "//,/*"
         if Upper( StrToken( cLine, 2 ) ) $ "DIALOGEX"
            oLbx:Add( cDlgName := StrToken( cLine, 1 ) )
            AAdd( aDialogs, { cDlgName, { cLine } } )
            lDone = .F.
         else
            if ! Empty( aDialogs )
               if Len( AllTrim( cLine ) ) == 1 .and. SubStr( cLine, 1, 1 ) == "}"
                  AAdd( ATail( aDialogs )[ 2 ], "}" )  
                  lDone = .T.
               else  
                  if ! lDone
                     AAdd( ATail( aDialogs )[ 2 ], cLine )  
                  endif  
               endif  
            endif  
         endif
      endif  
   next
   
   oLbx:GoTop()
   
return nil        

//----------------------------------------------------------------------------//

function ShowCode( cDlgName, oMemoRC, oMemoPrg )

   local nAt := AScan( aDialogs, { | aDlg | aDlg[ 1 ] == cDlgName } )
   
   if nAt != 0
      oMemoRC:SetText( ArrayToText( aDialogs[ nAt ][ 2 ] ) )
      oMemoPrg:SetText( RcToPrg( cDlgName, aDialogs[ nAt ][ 2 ] ) )
   endif  
   
return nil  

//----------------------------------------------------------------------------//

function ArrayToText( aArray )

   local n, cText := ""
   
   for n = 1 to Len( aArray )
      cText += aArray[ n ] + CRLF
   next
   
return cText

//----------------------------------------------------------------------------//

function RcToPrg( cDlgName, aRCSource )

   local cFuncName := "function " + cDlgName + "()" + CRLF + CRLF
   local n, cCode := "", aTokens, cToken
   local nSay := 0, nGet := 0, nBtn := 0, nLbx := 0, nChec := 0
   local cVarsSays := "   local "
   local cVarsGets := "   local "
   local cVarsButtons := "   local "
   local cVarsLbxs := "   local "
   local cVarsCheckBox := "   local "
   local cDlgDefine := "   DEFINE DIALOG oDlg RESOURCE " + '"' + ;
                       cDlgName + '"'
   local cId                  
   local cDlgActivate := "   ACTIVATE DIALOG oDlg CENTERED" + CRLF + CRLF
   
   for n = 1 to Len( aRCSource )
      aTokens = hb_ATokens( aRCSource[ n ] )
      cToken = AllTrim( aTokens[ 1 ] )
      // XBrowser aTokens
      do case
         case cToken == "EDITTEXT" .or. ;
              ( cToken == "CONTROL" .and. Upper( aTokens[ 4 ] ) == '"EDIT",' )
            if cToken == "EDITTEXT"  
               cId = AllTrim( StrTran( aTokens[ 2 ], ",", "" ) )
            else  
               cId = AllTrim( StrToken( aRCSource[ n ], 2, "," ) )
            endif  
            cCode += "   REDEFINE GET oGet" + AllTrim( Str( ++nGet ) ) + ;
                     " ID " + cId + " OF oDlg" + CRLF + CRLF
            cVarsGets += "oGet" + AllTrim( Str( nGet ) ) + ", "      

         case cToken == "LISTBOX"
            cId = AllTrim( StrTran( aTokens[ 2 ], ",", "" ) )
            cCode += "   REDEFINE LISTBOX oLbx" + AllTrim( Str( ++nLbx ) ) + ;
                     " ITEMS {}" + ;
                     " ID " + cId + " OF oDlg" + CRLF + CRLF
            cVarsLbxs += "oLbx" + AllTrim( Str( nLbx ) ) + ", "      
                     
         case cToken == "LTEXT"
            cId = AllTrim( StrToken( aRCSource[ n ], 2, ',' ) )
            if ! cId $ "0,-1" // We don't redefine 0 and -1 IDs
               cCode += "   REDEFINE SAY oSay" + AllTrim( Str( ++nSay ) ) + ;
                        " ID " + cId + " OF oDlg" + " // " + ;
                        StrTran( aTokens[ 2 ], ",", "" ) + CRLF + CRLF
               cVarsSays += "oSay" + AllTrim( Str( nSay ) ) + ", "      
            endif  
           
         case cToken == "AUTOCHECKBOX" .OR. cToken == "CHECKBOX"
            cId = AllTrim( StrToken( aRcSource[ n ], 2, ',' ) )
            cCode += "   REDEFINE CHECKBOX oCheck" + AllTrim( Str( ++nChec ) ) + ;
                     " ID " + cId + " OF oDlg // " + ;
                     '"' + StrToken( aRcSource[ n ], 2, '"' ) + '"' + CRLF + ;
                     CRLF
            cVarsCheckBox += "oCheck" + AllTrim( Str( nChec ) ) + ", "      

         case cToken == "PUSHBUTTON"
            cId = AllTrim( StrToken( aRcSource[ n ], 2, ',' ) )
            cCode += "   REDEFINE BUTTON oBtn" + AllTrim( Str( ++nBtn ) ) + ;
                     " ID " + cId + " OF oDlg ; // " + ;
                     '"' + StrToken( aRcSource[ n ], 2, '"' ) + '"' + CRLF + ;
                     "      ACTION MsgInfo( " + ;
                     '"' + StrToken( aRcSource[ n ], 2, '"' ) + '"' + " )" + ;
                     CRLF + CRLF
            cVarsButtons += "oBtn" + AllTrim( Str( nBtn ) ) + ", "      
      endcase
     
   next
   
   if Len( cVarsSays ) > Len( "   local " )
      cVarsSays = SubStr( cVarsSays, 1, Len( cVarsSays ) - 2 )
   else
      cVarsSays = ""
   endif
   
   if Len( cVarsGets ) > Len( "   local " )      
      cVarsGets = SubStr( cVarsGets, 1, Len( cVarsGets ) - 2 )
   else
      cVarsGets = ""
   endif
   
   if Len( cVarsButtons ) > Len( "   local " )
      cVarsButtons = SubStr( cVarsButtons, 1, Len( cVarsButtons ) - 2 )
   else  
      cVarsButtons = ""
   endif

   if Len( cVarsLbxs ) > Len( "   local " )
      cVarsLbxs = SubStr( cVarsLbxs, 1, Len( cVarsLbxs ) - 2 )
   else  
      cVarsLbxs = ""
   endif
   
   if Len( cVarsCheckBox ) > Len( "   local " )
      cVarsCheckBox = SubStr( cVarsCheckBox, 1, Len( cVarsCheckBox ) - 2 )
   else  
      cVarsCheckBox = ""
   endif
   
         
return cFuncName + ;
       "   local oDlg" + CRLF + ;
       If( ! Empty( cVarsSays ), cVarsSays + CRLF, "" ) + ;
       If( ! Empty( cVarsCheckBox ), cVarsCheckBox + CRLF, "" ) + ;   
       If( ! Empty( cVarsGets ), cVarsGets + CRLF, "" ) + ;
       If( ! Empty( cVarsButtons ), cVarsButtons + CRLF, "" ) + ;
       If( ! Empty( cVarsLbxs ), cVarsLbxs + CRLF, "" ) + ;
       If( ! Empty( cVarsSays ) .or. ! Empty( cVarsGets ) .or. ;
           ! Empty( cVarsButtons ) .or. ! Empty( cVarsLbxs ), CRLF, "" ) + ;
       If( Empty( cVarsSays ) .and. Empty( cVarsGets ) .and. ;
           Empty( cVarsButtons ) .and. Empty( cVarsLbxs ),;
       CRLF, "" ) + cDlgDefine + CRLF + ;
       CRLF + cCode + ;
       cDlgActivate + "return nil"            
       
//----------------------------------------------------------------------------//      
 

Re: Nueva utilidad REDEFINE.prg libre

PostPosted: Mon Jul 14, 2014 10:19 pm
by csincuir
Listo, cambiado nChec por nChk.

Carlos.

Code: Select all  Expand view

// Automatic REDEFINEs generator

#include "FiveWin.ch"

static cRCSrcCode, aDialogs := {}

//----------------------------------------------------------------------------//

function Main()

   local oDlg, oGet, cRCFileName := Space( 250 )
   local oLbx, cDlgName := Space( 50 ), oMemoRC, cCode := ""
   local oFont, oMemoPrg, cPrg := ""

   SetDlgGradient( { { 1, RGB( 199, 216, 237 ), RGB( 237, 242, 248 ) } } )
   
   DEFINE FONT oFont NAME "Courier New" SIZE 0, -14
   
   DEFINE DIALOG oDlg TITLE "RCs REDEFINEs builder" ;
      SIZE 900, 700

   @ 0.7, 1.5 SAY "RC filename:" OF oDlg SIZE 80, 9
   
   @ 0.8, 6 GET oGet VAR cRCFileName OF oDlg SIZE 200, 12 ;
      ACTION ( cRCFileName := cGetFile( "*.rc", "Please select a RC file" ),;
               oGet:oBtn:Refresh(), oGet:SetFocus(),;
               aDialogs := {}, ListDialogs( cRCFileName, oLbx ) )

   @ 2, 1.5 SAY "Dialogs in the RC file:" OF oDlg SIZE 80, 9

   @ 3, 1 LISTBOX oLbx VAR cDlgName ITEMS {} OF oDlg SIZE 80, 164 ;
      ON CHANGE ShowCode( cDlgName, oMemoRC, oMemoPrg )

   @ 2, 16.4 SAY "RC dialog source:" OF oDlg SIZE 80, 9

   @ 3.3, 12 GET oMemoRC VAR cCode MEMO OF oDlg SIZE 345, 157 ;
      FONT oFont HSCROLL

   @ 16, 1 GET oMemoPrg VAR cPrg MEMO OF oDlg SIZE 433, 135 ;
      FONT oFont HSCROLL

   ACTIVATE DIALOG oDlg CENTERED

   oFont:End()

return nil

//----------------------------------------------------------------------------//

function ListDialogs( cRCFileName, oLbx )

   local n, cDlgName, lDone, cLine, oRCFile

   if ! File( cRCFileName )
      MsgAlert( cRCFileName + " does not exist" )
      return nil
   endif  
   
   // cRCSrcCode = MemoRead( cRCFileName )
   oRCFile = TTxtFile():New( cRCFileName )
   oLbx:Reset()
   
   for n = 1 to oRCFile:RecCount() // MLCount( cRCSrcCode )
      cLine = oRCFile:ReadLine() // MemoLine( cRCSrcCode,, n )
      oRcFile:Skip()
      SysRefresh()
      if ! SubStr( cLine, 1, 2 ) $ "//,/*"
         if Upper( StrToken( cLine, 2 ) ) $ "DIALOGEX"
            oLbx:Add( cDlgName := StrToken( cLine, 1 ) )
            AAdd( aDialogs, { cDlgName, { cLine } } )
            lDone = .F.
         else
            if ! Empty( aDialogs )
               if Len( AllTrim( cLine ) ) == 1 .and. SubStr( cLine, 1, 1 ) == "}"
                  AAdd( ATail( aDialogs )[ 2 ], "}" )  
                  lDone = .T.
               else  
                  if ! lDone
                     AAdd( ATail( aDialogs )[ 2 ], cLine )  
                  endif  
               endif  
            endif  
         endif
      endif  
   next
   
   oLbx:GoTop()
   
return nil        

//----------------------------------------------------------------------------//

function ShowCode( cDlgName, oMemoRC, oMemoPrg )

   local nAt := AScan( aDialogs, { | aDlg | aDlg[ 1 ] == cDlgName } )
   
   if nAt != 0
      oMemoRC:SetText( ArrayToText( aDialogs[ nAt ][ 2 ] ) )
      oMemoPrg:SetText( RcToPrg( cDlgName, aDialogs[ nAt ][ 2 ] ) )
   endif  
   
return nil  

//----------------------------------------------------------------------------//

function ArrayToText( aArray )

   local n, cText := ""
   
   for n = 1 to Len( aArray )
      cText += aArray[ n ] + CRLF
   next
   
return cText

//----------------------------------------------------------------------------//

function RcToPrg( cDlgName, aRCSource )

   local cFuncName := "function " + cDlgName + "()" + CRLF + CRLF
   local n, cCode := "", aTokens, cToken
   local nSay := 0, nGet := 0, nBtn := 0, nLbx := 0, nChk := 0
   local cVarsSays := "   local "
   local cVarsGets := "   local "
   local cVarsButtons := "   local "
   local cVarsLbxs := "   local "
   local cVarsCheckBox := "   local "
   local cDlgDefine := "   DEFINE DIALOG oDlg RESOURCE " + '"' + ;
                       cDlgName + '"'
   local cId                  
   local cDlgActivate := "   ACTIVATE DIALOG oDlg CENTERED" + CRLF + CRLF
   
   for n = 1 to Len( aRCSource )
      aTokens = hb_ATokens( aRCSource[ n ] )
      cToken = AllTrim( aTokens[ 1 ] )
      // XBrowser aTokens
      do case
         case cToken == "EDITTEXT" .or. ;
              ( cToken == "CONTROL" .and. Upper( aTokens[ 4 ] ) == '"EDIT",' )
            if cToken == "EDITTEXT"  
               cId = AllTrim( StrTran( aTokens[ 2 ], ",", "" ) )
            else  
               cId = AllTrim( StrToken( aRCSource[ n ], 2, "," ) )
            endif  
            cCode += "   REDEFINE GET oGet" + AllTrim( Str( ++nGet ) ) + ;
                     " ID " + cId + " OF oDlg" + CRLF + CRLF
            cVarsGets += "oGet" + AllTrim( Str( nGet ) ) + ", "      

         case cToken == "LISTBOX"
            cId = AllTrim( StrTran( aTokens[ 2 ], ",", "" ) )
            cCode += "   REDEFINE LISTBOX oLbx" + AllTrim( Str( ++nLbx ) ) + ;
                     " ITEMS {}" + ;
                     " ID " + cId + " OF oDlg" + CRLF + CRLF
            cVarsLbxs += "oLbx" + AllTrim( Str( nLbx ) ) + ", "      
                     
         case cToken == "LTEXT"
            cId = AllTrim( StrToken( aRCSource[ n ], 2, ',' ) )
            if ! cId $ "0,-1" // We don't redefine 0 and -1 IDs
               cCode += "   REDEFINE SAY oSay" + AllTrim( Str( ++nSay ) ) + ;
                        " ID " + cId + " OF oDlg" + " // " + ;
                        StrTran( aTokens[ 2 ], ",", "" ) + CRLF + CRLF
               cVarsSays += "oSay" + AllTrim( Str( nSay ) ) + ", "      
            endif  
           
         case cToken == "AUTOCHECKBOX" .OR. cToken == "CHECKBOX"
            cId = AllTrim( StrToken( aRcSource[ n ], 2, ',' ) )
            cCode += "   REDEFINE CHECKBOX oCheck" + AllTrim( Str( ++nChk ) ) + ;
                     " ID " + cId + " OF oDlg // " + ;
                     '"' + StrToken( aRcSource[ n ], 2, '"' ) + '"' + CRLF + ;
                     CRLF
            cVarsCheckBox += "oCheck" + AllTrim( Str( nChk ) ) + ", "      

         case cToken == "PUSHBUTTON"
            cId = AllTrim( StrToken( aRcSource[ n ], 2, ',' ) )
            cCode += "   REDEFINE BUTTON oBtn" + AllTrim( Str( ++nBtn ) ) + ;
                     " ID " + cId + " OF oDlg ; // " + ;
                     '"' + StrToken( aRcSource[ n ], 2, '"' ) + '"' + CRLF + ;
                     "      ACTION MsgInfo( " + ;
                     '"' + StrToken( aRcSource[ n ], 2, '"' ) + '"' + " )" + ;
                     CRLF + CRLF
            cVarsButtons += "oBtn" + AllTrim( Str( nBtn ) ) + ", "      
      endcase
     
   next
   
   if Len( cVarsSays ) > Len( "   local " )
      cVarsSays = SubStr( cVarsSays, 1, Len( cVarsSays ) - 2 )
   else
      cVarsSays = ""
   endif
   
   if Len( cVarsGets ) > Len( "   local " )      
      cVarsGets = SubStr( cVarsGets, 1, Len( cVarsGets ) - 2 )
   else
      cVarsGets = ""
   endif
   
   if Len( cVarsButtons ) > Len( "   local " )
      cVarsButtons = SubStr( cVarsButtons, 1, Len( cVarsButtons ) - 2 )
   else  
      cVarsButtons = ""
   endif

   if Len( cVarsLbxs ) > Len( "   local " )
      cVarsLbxs = SubStr( cVarsLbxs, 1, Len( cVarsLbxs ) - 2 )
   else  
      cVarsLbxs = ""
   endif
   
   if Len( cVarsCheckBox ) > Len( "   local " )
      cVarsCheckBox = SubStr( cVarsCheckBox, 1, Len( cVarsCheckBox ) - 2 )
   else  
      cVarsCheckBox = ""
   endif
   
         
return cFuncName + ;
       "   local oDlg" + CRLF + ;
       If( ! Empty( cVarsSays ), cVarsSays + CRLF, "" ) + ;
       If( ! Empty( cVarsCheckBox ), cVarsCheckBox + CRLF, "" ) + ;   
       If( ! Empty( cVarsGets ), cVarsGets + CRLF, "" ) + ;
       If( ! Empty( cVarsButtons ), cVarsButtons + CRLF, "" ) + ;
       If( ! Empty( cVarsLbxs ), cVarsLbxs + CRLF, "" ) + ;
       If( ! Empty( cVarsSays ) .or. ! Empty( cVarsGets ) .or. ;
           ! Empty( cVarsButtons ) .or. ! Empty( cVarsLbxs ), CRLF, "" ) + ;
       If( Empty( cVarsSays ) .and. Empty( cVarsGets ) .and. ;
           Empty( cVarsButtons ) .and. Empty( cVarsLbxs ),;
       CRLF, "" ) + cDlgDefine + CRLF + ;
       CRLF + cCode + ;
       cDlgActivate + "return nil"            
       
//----------------------------------------------------------------------------//      
 

Re: Nueva utilidad REDEFINE.prg libre

PostPosted: Mon Jul 14, 2014 10:53 pm
by Antonio Linares
Carlos,

Muchas gracias por tu ayuda :-)

A ver si podemos ir añadiendo los controles más habituales para hacerlo operativo

Re: Nueva utilidad REDEFINE.prg libre

PostPosted: Mon Jul 14, 2014 11:13 pm
by Antonio Linares
Carlos,

Recordaba que teníamos en FWH un desarrollo de editor de recursos que aún es más potente: samples\re.prg

De hecho re.prg permite además visualizar el diálogo:

Image

Image

Podriamos mejorar re.prg y asi conseguir más potencia :-)

Re: Nueva utilidad REDEFINE.prg libre

PostPosted: Tue Jul 15, 2014 1:56 am
by csincuir
Me parece Antonio, con gusto te puedo ayudar en lo que pueda a mejorar esta otra utilidad.
Voy a buscar el re.prg y voy a hacer las pruebas con los rc que estaba verificanco con REDEFINE.prg

Saludos.

Carlos.

Re: Nueva utilidad REDEFINE.prg libre

PostPosted: Tue Jul 15, 2014 6:05 am
by Biel EA6DD
Antonio, GETs ok, cuando tenga un momento puedo añadir resto de componentes.

Re: Nueva utilidad REDEFINE.prg libre

PostPosted: Tue Jul 15, 2014 6:12 am
by Antonio Linares
Biel,

Muchas gracias por tu ayuda

Re: Nueva utilidad REDEFINE.prg libre

PostPosted: Tue Jul 15, 2014 2:34 pm
by Antonio Linares
Carlos,

Muchas gracias por tu ayuda :-)
All times are UTC
Page 2 of 3
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/