FiveTech Software tech support forums

Code: Select all

#include "FiveMac.ch"
#include "error.ch"
#include "dbinfo.ch"

extern dbfcdx, DBCloseArea, DbUseArea, DbGoTo
extern HB_Run, HB_HRBRun, HB_HRBLoad, HB_HRBDo, HB_HRBUnLoad
extern CurDir, Directory, MemoWrit

static oWndCommand, oWndResult

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

function Main()

   local oMemo, cCommand := "", oBar
   
   RddSetDefault( "DBFCDX" )
   
   BuildMenu()
   BuildPreprocessor()
   
   DEFINE WINDOW oWndCommand TITLE "Command" ;
      FROM 90, 255 TO 556, 265
      
   DEFINE TOOLBAR oBar OF oWndCommand     
  
   DEFINE BUTTON OF oBar PROMPT "New" ;
      TOOLTIP "Creates a new file" ;
      IMAGE "./../bitmaps/new.png"
      
   DEFINE BUTTON OF oBar PROMPT "Open" ;
      TOOLTIP "Open a file" ;
      IMAGE "./../bitmaps/folder.png"
      
   DEFINE BUTTON OF oBar PROMPT "Save" ;
      TOOLTIP "Save a file" ;
      IMAGE "" ;
      ACTION ( TxtHighlight( oMemo:hWnd ), oMemo:Refresh() )    
      
   @ 20, 20 GET oMemo VAR cCommand MEMO OF oWndCommand SIZE 516, 225

   oMemo:SetBkColor( nRGB( 160, 160, 160 ) )
   oMemo:SetFont( "Monaco", 13 )

   oMemo:bKeyDown = { | nKey | DoLine( nKey, oMemo ) }

   ButtonBar()
   
   ACTIVATE WINDOW oWndCommand
   
return nil

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

function _QOut( cText )

   if oWndResult == nil
      BuildResult()
   endif   

   oWndResult:aControls[ 1 ]:AddLine( cValToChar( cText ) + CRLF )
   oWndResult:aControls[ 1 ]:GoBottom()
   
return nil   

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

function _Clear()

   oWndResult:aControls[ 1 ]:SetText( "" )
   
return nil   

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

function DoLine( nKey, oMemo )

   local cCommand, cPP, oError
   local bError
   
   if nKey != 13 .and. nKey != 3
      return nil
   endif

   cCommand = MemoLine( oMemo:GetText(),, oMemo:nRow() - 1 )
   if Empty( cCommand )
      return nil
   endif   
   cPP = __PreProcess( cCommand )

   bError = ErrorBlock( { | o | Break( o ) } )
   BEGIN SEQUENCE
      &cPP
   RECOVER USING oError
      ShowError( oError )
   END SEQUENCE   
   ErrorBlock( bError )

return nil   

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

function ShowError( oError )

   local n, cMsg := "Error description: " + CRLF + ErrorMessage( oError ) + CRLF

   if ValType( oError:Args ) == "A"
      cMsg += "   Args:" + CRLF
      for n = 1 to Len( oError:Args )
         cMsg += "     [" + Str( n, 4 ) + "] = " + ValType( oError:Args[ n ] ) + ;
                      "   " + cValToChar( oError:Args[ n ] ) + CRLF
      next
   endif   

   MsgAlert( cMsg )

return nil   

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

function BuildMenu()

   local oMenu
   
   MENU oMenu
   
     MENUITEM "osxpro"
     MENU
        MENUITEM "Preferences..." ACCELERATOR ","
     ENDMENU
   
      MENUITEM "File"
      MENU
         MENUITEM "New..." ACCELERATOR "n"
         MENUITEM "Open..." ACCELERATOR "o"
         MENUITEM "Close"
         SEPARATOR
         MENUITEM "Save" ACCELERATOR "s"
         MENUITEM "Save As..."
         MENUITEM "Save As HTML..."
         MENUITEM "Revert"
         SEPARATOR
         MENUITEM "Import..."
         MENUITEM "Export..."
         SEPARATOR
         MENUITEM "Page Setup..."
         MENUITEM "Print Preview"
         MENUITEM "Print"
         SEPARATOR
         MENUITEM "Send..."
         MENUITEM "Exit" ACTION oWndCommand:End() ACCELERATOR "e"
      ENDMENU
      
      MENUITEM "Edit"
      MENU
      ENDMENU
      
      MENUITEM "View"
      MENU
      ENDMENU
      
      MENUITEM "Format"
      MENU
      ENDMENU
      
      MENUITEM "Tools"
      MENU
      ENDMENU
      
      MENUITEM "Program"
      MENU
         MENUITEM "Do..."
         MENUITEM "Cancel"
         MENUITEM "Resume"
         MENUITEM "Suspend"
         SEPARATOR
         MENUITEM "Compile"
      ENDMENU
      
      MENUITEM "Window"
      MENU
         MENUITEM "Hide"
         MENUITEM "Clear"
         MENUITEM "Cycle"
         SEPARATOR
         MENUITEM "Command Window"
         MENUITEM "Result Window" ACTION BuildResult()
         MENUITEM "Data Session"
         MENUITEM "Properties Window"
      ENDMENU
      
      MENUITEM "Help"
      MENU
         MENUITEM "About OsxPro..." ;
            ACTION MsgInfo( "Developed with FiveMac" + CRLF + "(c) FiveTech Software 2006-7", "OsxPro" )
      ENDMENU
      
   ENDMENU
   
return nil   

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

function New()

   local oWnd, cType := "Program"

   DEFINE WINDOW oWnd TITLE "New" ;
      FROM 0, 62 TO 290, 450
      
   @ 415, 20 SAY "File type" OF oWnd

   @ 385, 32 RADIO oRadMenu VAR cType ;
      ITEMS { "Project", "DataBase", "Table", "Query", "Connection", "View", "Remote view",;
                 "Form", "Report", "Label", "Program", "Class", "Text file", "Menu" } ;
      OF oWnd 
   
   @ 385, 170 BUTTON "New file" OF oWnd ;
      ACTION If( cType == 11, ( oWnd:End(), ModifyCommand( "test.prg" ) ),)    

   @ 355, 170 BUTTON "Wizard" OF oWnd   

   @  50, 170 BUTTON "Cancel" OF oWnd ACTION oWnd:End()  

   @  20, 170 BUTTON "Help" OF oWnd   
   
   ACTIVATE WINDOW oWnd

return nil

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

function BuildResult()

   local oMemo, oBar, cResult := ""
   
   if oWndResult != nil
      return nil
   endif   

   DEFINE WINDOW oWndResult TITLE "Result" ;
      FROM 217, 21 TO 556, 265

   DEFINE TOOLBAR oBar OF oWndResult
   
   DEFINE BUTTON OF oBar PROMPT "New"
   DEFINE BUTTON OF oBar PROMPT "Open"
   DEFINE BUTTON OF oBar PROMPT "Save"
      
   @ 20, 20 GET oMemo VAR cResult MEMO OF oWndResult SIZE 516, 225
   
   oMemo:SetEditable( .f. )
   oMemo:SetBkColor( nRGB( 160, 160, 160 ) )
   oMemo:SetFont( "Monaco", 13 )  
   
   ACTIVATE WINDOW oWndResult ;
      VALID ( oWndResult := nil, .t. )
   
   oWndCommand:SetFocus()
   
return nil

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

function Browse()

   local oWnd, oBrw 

   if Empty( Alias() )
      return nil
   endif   
   
   DEFINE WINDOW oWnd TITLE Alias() ;
      FROM 213, 109 TO 717, 431

   @ 48, 20 LISTBOX oBrw OF oWnd SIZE 672, 363 ALIAS Alias()
   
   ACTIVATE WINDOW oWnd
   
return nil   

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

function DoCommand( cPrgName )

   local cPrg, pCode

   if ! "." $ cPrgName
      cPrgName += ".prg"
   endif   
   
   if ! File( cPrgName )
      MsgAlert( cPrgName + " : file not found" )
      return nil
   endif

   cPrg = MemoRead( cPrgName )
   __Run( "./../../harbour/bin/harbour " + cPrgName + " -gh -n -I./../../harbour/include:./../include > comp.log" )
   // _QOut( MemoRead( "comp.log" ) )
   if At( "error", MemoRead( "comp.log" ) ) != 0
      MsgInfo( MemoRead( "comp.log" ) )
   endif      

   if File( SubStr( cPrgName, 1, At( ".", cPrgName ) ) + "hrb" )
      pCode = HB_HRBLoad( SubStr( cPrgName, 1, At( ".", cPrgName ) ) + "hrb" )
      HB_HRBDo( pCode )
      HB_HRBUnLoad( pCode )
   endif   
   
return nil   
   
//----------------------------------------------------------------------------//

function DoForm( cFileName )

   local oForm, oControl

   if ! "." $ cFileName
      cFileName += ".scx"
   endif   
   
   if ! File( cFileName )
      MsgAlert( cFileName + " : file not found" )
      return nil
   endif

   RddInfo( RDDI_MEMOEXT, ".sct" )
   USE ( cFileName ) NEW
   SKIP 2
   
   if Upper( Class ) == "FORM"
      oForm = TWindow():New()
      SetProps( oForm, properties )

       while ! EoF() .and. ! Empty( Class )
          oControl = nil
          SKIP
          do case
           case Upper( Class ) == "COMMANDBUTTON"
                   oControl = TButton():New()
               
           case Upper( Class ) == "LABEL"
                   oControl = TSay():New()

              case Upper( Class ) == "TEXTBOX"
                   oControl = TGet():New()
               
      endcase
      if oControl != nil
         SetProps( oControl, properties )
      endif   
      end     
       
      oForm:Activate()
   endif   

   USE
   RddInfo( RDDI_MEMOEXT, ".fpt" )
   
return nil

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

function SetProps( oControl, cProperties )

   local n, cLine, cProp, cValue

   for n = 1 to MLCount( cProperties )
      cLine = MemoLine( cProperties,, n )
      cProp = Upper( AllTrim( StrToken( cLine, 1, "=" ) ) )
      cValue = AllTrim( StrToken( cLine, 2, "=" ) )

      do case
           case cProp == "TOP"
               if ! oControl:IsDerivedFrom( TControl() )
                  oControl:nTop = Val( cValue )
           else   
                  oControl:nTop = GetWndDefault():nHeight - Val( cValue ) - 40
              if oControl:IsDerivedFrom( TSay() )
                 oControl:nTop += 10
              endif 
           endif   
           
       case cProp == "LEFT"
            oControl:nLeft = Val( cValue )
           
       case cProp == "WIDTH"
            oControl:nWidth = Val( cValue )
           
       case cProp == "HEIGHT"
            oControl:nHeight = Val( cValue )
           
       case cProp == "CAPTION"
            oControl:SetText( &cValue )

       case cProp == "NAME"
            if oControl:IsDerivedFrom( TGet() )
               oControl:SetText( &cValue )
            endif   
       endcase         
    next

return nil

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

function Edit()

   local oWnd, oBrw 

   if Empty( Alias() )
      return nil
   endif   
   
   DEFINE WINDOW oWnd TITLE Alias() ;
      FROM 213, 109 TO 717, 431

   @ 48, 20 LISTBOX oBrw FIELDS "", "" HEADERS "FieldName", "Value" ;
      OF oWnd SIZE 672, 363 ALIAS Alias()
   
   oBrw:SetEdit()   
      
   ACTIVATE WINDOW oWnd
   
return nil   

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

function ModifyCommand( cPrgName )

   local oWnd, cPrg := "", oMemo, oBar
   
   if ! "." $ cPrgName
      cPrgName += ".prg"
   endif   
   
   if File( cPrgName )
      cPrg = MemoRead( cPrgName )
   else
      cPrg = '#include "FiveMac.ch"' + CRLF + CRLF + ;
             "function Main()" + CRLF + CRLF + CRLF + CRLF + ;
             "return nil"   
   endif   
   
   DEFINE WINDOW oWnd TITLE cPrgName ;
      FROM 22, 120 TO 600, 392
      
   DEFINE TOOLBAR oBar OF oWnd
   
   DEFINE BUTTON OF oBar ;
      PROMPT  "New" ;
      TOOLTIP "Create a new PRG" ;
      IMAGE   "./../bitmaps/new.png" ;
      ACTION MsgInfo( oWnd:nTop )

   DEFINE BUTTON OF oBar ;
      PROMPT  "Run" ;
      TOOLTIP "Build and run the PRG" ;
      IMAGE   "./../bitmaps/run.tiff" ;
      ACTION  ( MemoWrit( "_temp.prg", oMemo:GetText() ), DoCommand( "_temp.prg" ) )
         
   @ 0, 0 GET oMemo VAR cPRG MEMO OF oWnd SIZE 606, 392
      
   oMemo:SetBkColor( nRGB( 160, 160, 160 ) )
   oMemo:SetFont( "Monaco", 13 )      
      
   ACTIVATE WINDOW oWnd ;
      VALID ( If( MsgYesNo( "Do you want to save changes to " + cPrgName + " ?" ),;
                  MemoWrit( cPrgName, oMemo:GetText() ),), .t. ) ;
      ON CLICK MsgInfo( oWnd:nTop )           

return nil

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

function BuildPreprocessor()

   __preprocess( "#xcommand ?  [ <list,...> ] => _QOut( <list> )" )
   __preprocess( "#xcommand ?? [ <list,...> ] => _QQOut( <list> )" )
   __preprocess( "#xcommand BROWSE => Browse()" )
   __preprocess( "#xcommand CLEAR => _Clear()" )
   __preprocess( "#xcommand DO COMMAND <x> => DoCommand( <(x)> )" )
   __preprocess( "#xcommand DO FORM <x> => DoForm( <(x)> )" )
   __preprocess( "#xcommand EDIT => Edit()" ) 
   __preprocess( "#xcommand ENDPROC => return" )
   __preprocess( "#xcommand MODIFY COMMAND <x> => ModifyCommand( <(x)> )" )
   __preprocess( "#xcommand PUBLIC <x> => __mvPublic( <(x)> )" )

return nil

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

static function ErrorMessage( e )

   // start error message
   local cMessage := if( empty( e:OsCode ), ;
                          if( e:severity > ES_WARNING, "Error ", "Warning " ),;
                          "(DOS Error " + AllTrim( Str( e:osCode ) ) + ") " )

   // add subsystem name if available
   cMessage += if( ValType( e:SubSystem ) == "C",;
                    e:SubSystem()                ,;
                    "???" )

   // add subsystem's error code if available
   cMessage += if( ValType( e:SubCode ) == "N",;
                    "/" + AllTrim( Str( e:SubCode ) )  ,;
                    "/???" )
   // add error description if available
   if ( ValType( e:Description ) == "C" )
        cMessage += "  " + e:Description
   end

   // add either filename or operation
   cMessage += if( ! Empty( e:FileName ),;
                    ": " + e:FileName   ,;
                    if( !Empty( e:Operation ),;
                        ": " + e:Operation   ,;
                        "" ) )
return cMessage

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

function ButtonBar()

   local oWnd, oBar
   
   DEFINE WINDOW oWnd TITLE "" FROM 590, 0 TO 832, 0 PANELED TEXTURED

   DEFINE TOOLBAR oBar OF oWnd
   
   DEFINE BUTTON OF oBar PROMPT "New" ;
      TOOLTIP "Create a new file" ;
      IMAGE "./../bitmaps/new.png" ;
      ACTION New()

   DEFINE BUTTON OF oBar PROMPT "Open" ;
      TOOLTIP "Open a file" ;
      IMAGE "./../bitmaps/folder.png" ;
      ACTION MsgInfo( "Open" )

   DEFINE BUTTON OF oBar PROMPT "Save" ;
      TOOLTIP "Save the file" ;
      IMAGE "./../bitmaps/floppy.png" ;
      ACTION MsgInfo( "Save" )

   /*
   @ 5, 5 BTNBMP FILENAME "bitmaps/new.png" ACTION New()
   @ 5, 50 BTNBMP FILENAME "bitmaps/open.png"
   @ 5, 95 BTNBMP FILENAME "bitmaps/save.png"

   @ 5, 147 BTNBMP FILENAME "bitmaps/print.png"
   @ 5, 192 BTNBMP FILENAME "bitmaps/preview.png"

   @ 5, 244 BTNBMP FILENAME "bitmaps/cut.tiff"
   @ 5, 289 BTNBMP FILENAME "bitmaps/copy.tiff"
   @ 5, 334 BTNBMP FILENAME "bitmaps/save.png"

   @ 5, 386 BTNBMP FILENAME "bitmaps/left.png"
   @ 5, 431 BTNBMP FILENAME "bitmaps/right.png"

   @ 5, 483 BTNBMP FILENAME "bitmaps/print.png"
   @ 5, 528 BTNBMP FILENAME "bitmaps/run.png"
   */
   
   ACTIVATE WINDOW oWnd ;
      ON CLICK MsgInfo( oWnd:nTop )
   
return nil   

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