home *** CD-ROM | disk | FTP | other *** search
/ mail.altrad.com / 2015.02.mail.altrad.com.tar / mail.altrad.com / TEST / COMMERC_72_53OLD / commerc / PROGSOLD / mydbedit.prg < prev    next >
Text File  |  2014-04-02  |  8KB  |  287 lines
  1. //////////////////////////////////////////////////////////////////////
  2. //
  3. //  MY_DBEDIT.PRG
  4. //
  5. //  Copyright:
  6. //      Alaska Software, (c) 1998-2002. All rights reserved.         
  7. //  
  8. //  Contents:
  9. //      Compatiblity function DbEdit() to display databases (DBF files)
  10. //   
  11. //////////////////////////////////////////////////////////////////////
  12.             
  13. #include "Inkey.ch"
  14. #include "Appevent.ch"
  15. #include "Dbedit.ch"
  16.  
  17. ****************************************************************************
  18. * Compatiblity function DbEdit()
  19. ****************************************************************************
  20. PROCEDURE My_DbEdit( nTop      , ;        // Window coordinate: top
  21.                   nLeft     , ;        // left
  22.                   nBottom   , ;        // bottom
  23.                   nRight    , ;        // right
  24.                   aColumns  , ;        // Table columns
  25.                   bcUserFunc, ;        // User function or code block
  26.                   acPicture , ;        // PICTURE formats
  27.                   acHeading , ;        // Column heading(s)
  28.                   acHeadSep , ;        // Heading separator(s)
  29.                   acColSep  , ;        // Column separator(s)
  30.                   acFootSep , ;        // Footing separator(s)
  31.                   acFooting   )        // Column footing(s)
  32. LOCAL oTBrowse, oTBColumn, i, imax, nKey, nMode, nExit, nCursor
  33. LOCAL cHeadSepType, cColSepType, cFootSepType, cPictType, cFootingType
  34. LOCAL nEvent, mp1, mp2, oXbp, lUseEvent
  35.                                                               
  36.    nCursor := SetCursor(0)
  37.    
  38.    /* 
  39.     * No columns specified, display all fields    
  40.     */
  41.    IF aColumns == NIL                  
  42.       aColumns := DbStruct()           
  43.       AEval( aColumns, {|a| a := a[1] },,, .T. )
  44.    ENDIF
  45.    /* 
  46.     * Create TBrowse 
  47.     */
  48.    oTbrowse         := TBrowseDB( nTop, nLeft, nBottom, nRight )
  49.    oTBrowse:headSep := IIf( Valtype(acHeadSep)=="C", acHeadSep, "═╤═" )
  50.    oTbrowse:colSep  := IIf( Valtype(acColSep) =="C", acColSep , " │ " )
  51.  
  52.    /* 
  53.     * Same footing separator for all footings 
  54.     */
  55.    IF Valtype( acFootSep ) == "C"      
  56.    
  57.       oTBrowse:footSep := acFootSep    
  58.    ENDIF
  59.  
  60.    /* 
  61.     * Column headings must exist 
  62.     */
  63.    IF acHeading == NIL                 
  64.       acHeading := AClone( aColumns )
  65.    /* 
  66.     * Same heading for all columns 
  67.     */
  68.    ELSEIF Valtype( acHeading ) == "C"  
  69.       acHeading := AFill( Array( Len(aColumns) ), acHeading )
  70.    ENDIF
  71.  
  72.    /* 
  73.     * A footing for all columns 
  74.     */
  75.    IF Valtype( acFooting ) == "C"      
  76.       acFooting := AFill( Array( Len(aColumns) ), acFooting )
  77.    ENDIF
  78.  
  79.    /* 
  80.     * Same PICTURE for all columns 
  81.     */
  82.    IF Valtype( acPicture ) == "C"      
  83.       acPicture := AFill( Array( Len(aColumns) ), acPicture )
  84.    ENDIF
  85.  
  86.    imax         := Len( aColumns )
  87.    cHeadSepType := Valtype( acHeadSep )
  88.    cColSepType  := Valtype( acColSep )
  89.    cFootSepType := Valtype( acFootSep )
  90.    cPictType    := Valtype( acPicture )
  91.    cFootingType := Valtype( acFooting )
  92.  
  93.    /* 
  94.     * Create TBColumn objects 
  95.     */
  96.    FOR i:=1 TO imax                    
  97.       IF Type( aColumns[i] ) == "M"
  98.          oTBColumn := TBColumnNew( acHeading[i], {|| "  <Memo>  "} )
  99.       ELSE
  100.          oTBColumn := TBColumnNew( acHeading[i], &("{||"+aColumns[i]+"}"))
  101.       ENDIF
  102.  
  103.       IF  cHeadSepType == "A"
  104.          oTBColumn:headSep := acHeadSep[i]
  105.       ENDIF
  106.  
  107.       IF cColSepType == "A"
  108.          oTBColumn:colSep := acColSep[i]
  109.       ENDIF
  110.  
  111.       IF cFootSepType == "A"
  112.          oTBColumn:footSep := acFootSep[i]
  113.       ENDIF
  114.  
  115.       IF cFootingType == "A"
  116.          oTBColumn:footing := acFooting[i]
  117.       ENDIF
  118.  
  119.       IF cPictType == "A"
  120.          oTBColumn:picture := acPicture[i]
  121.       ENDIF
  122.  
  123.       /* 
  124.        * Add column to Tbrowse 
  125.        */
  126.       oTBrowse:addColumn( oTBColumn )  
  127.    NEXT
  128.  
  129.    /* 
  130.     * Compile user function to code block 
  131.     */
  132.    IF Valtype( bcUserFunc ) == "C"     
  133.       bcUserFunc := &("{|nMode,nColPos|"+bcUserFunc+"(nMode,nColPos) }")
  134.    ELSEIF Valtype( bcUserFunc ) <> "B" 
  135.       /* 
  136.        * Set user function codeblock to NIL (for compatibility reasons) 
  137.        */
  138.       bcUserFunc := NIL                
  139.    ENDIF
  140.  
  141.    nMode     := DE_IDLE
  142.    nExit     := DE_CONT
  143.    lUseEvent := SetMouse()
  144.  
  145.    DO WHILE nExit <> DE_ABORT
  146.  
  147.       /* 
  148.        * Incremental display ... 
  149.        */
  150.       DO WHILE ! oTBrowse:stabilize()  
  151.          IF lUseEvent
  152.             IF (nEvent := NextAppEvent( @mp1, @mp2, @oXbp )) > xbe_None .AND. ;
  153.                (nEvent <> xbeM_Motion )
  154.                nEvent := AppEvent( @mp1, @mp2, @oXbp )
  155.                EXIT
  156.             ENDIF
  157.          ELSE
  158.             /* 
  159.              * ... is interrupted by a key press 
  160.              */
  161.             IF (nKey := InKey()) <> 0   
  162.                EXIT                     
  163.             ENDIF
  164.          ENDIF
  165.       ENDDO
  166.  
  167.       /* 
  168.        * TBrowse is stable 
  169.        */
  170.       IF oTBrowse:stable               
  171.          IF bcUserFunc <> NIL
  172.             /* 
  173.              * Set DbEdit modes 
  174.              */
  175.             DO CASE                    
  176.             CASE LastRec() == 0 .AND. nMode != DE_EXCEPT
  177.                nMode := DE_EMPTY
  178.             CASE nMode == DE_EXCEPT
  179.             CASE oTBrowse:hitTop
  180.                nMode := DE_HITTOP
  181.             CASE oTBrowse:hitBottom
  182.                nMode := DE_HITBOTTOM
  183.             ENDCASE
  184.             /* 
  185.              * Execute User function 
  186.              */
  187.             nExit := Eval( bcUserFunc, nMode, oTbrowse:colPos )
  188.             IF Valtype( nExit ) <> "N"
  189.                nExit := DE_CONT
  190.             ENDIF
  191.  
  192.             /* 
  193.              * Return value of User function 
  194.              */
  195.             IF nExit == DE_REFRESH     
  196.                oTBrowse:refreshAll()
  197.                nExit := DE_CONT
  198.                nMode := DE_IDLE
  199.                LOOP
  200.             ELSEIF nExit == DE_CONT
  201.                oTBrowse:refreshCurrent()
  202.                oTBrowse:forceStable()
  203.             ELSEIF nExit == DE_ABORT
  204.                EXIT
  205.             ENDIF
  206.          ENDIF
  207.  
  208.          nMode := DE_IDLE
  209.          nExit := DE_CONT
  210.          /* 
  211.           * Get next event 
  212.           */
  213.          IF lUseEvent                   
  214.             /* 
  215.              * "Mouse motion" is ignored 
  216.              */
  217.             nEvent := xbeM_Motion       
  218.             DO WHILE nEvent == xbeM_Motion
  219.                nEvent := AppEvent( @mp1, @mp2, @oXbp, 0 )
  220.                IF nEvent == xbeM_Motion .AND. Set( _SET_HANDLEEVENT )
  221.                   oXbp:HandleEvent( nEvent, mp1, mp2 )
  222.                ENDIF
  223.             ENDDO
  224.          ELSE
  225.             /* 
  226.              * Wait for a key press 
  227.              */
  228.             nKey   := InKey(0)          
  229.          ENDIF
  230.       ENDIF
  231.  
  232.       IF lUseEvent
  233.          nKey := 0
  234.          IF nEvent == xbeM_LbDown
  235.             IF TBHandleEvent( oTBrowse, nEvent, mp1, mp2, oXbp ) <> 0
  236.                nMode := DE_IDLE
  237.             ENDIF
  238.             /* 
  239.              * Key was pressed 
  240.              */   
  241.          ELSEIF nEvent < xbeB_Event    
  242.             DO CASE                          
  243.             CASE nEvent == 0
  244.             CASE nEvent == K_ENTER .OR. nEvent == K_ESC
  245.                 IF bcUserFunc == NIL
  246.                    nExit := DE_ABORT
  247.                 ELSE
  248.                    nMode := DE_EXCEPT
  249.                 ENDIF
  250.             CASE TBHandleEvent( oTBrowse, nEvent, mp1, mp2, oXbp ) > 0
  251.             OTHERWISE
  252.                 nMode := DE_EXCEPT
  253.             ENDCASE
  254.          ELSE
  255.             /* 
  256.              * Handle unknown event 
  257.              */
  258.             TBHandleEvent( oTBrowse, nEvent, mp1, mp2, oXbp )
  259. *            nMode := DE_EXCEPT    // WRONG !!!!!!!!!!
  260.             nMode := DE_IDLE
  261.          ENDIF
  262.       ELSE
  263.          /* 
  264.           * Process key 
  265.           */
  266.          DO CASE                          
  267.          CASE nKey == 0
  268.          CASE nKey == K_ENTER .OR. nKey == K_ESC
  269.             IF bcUserFunc == NIL
  270.                nExit := DE_ABORT
  271.             ELSE
  272.                nMode := DE_EXCEPT
  273.             ENDIF
  274.          CASE TBApplyKey( oTBrowse, nKey ) > 0
  275.          OTHERWISE
  276.             nMode := DE_EXCEPT
  277.          ENDCASE
  278.       ENDIF
  279.    ENDDO
  280.  
  281.    SetCursor(nCursor)
  282.  
  283. RETURN
  284.  
  285.  
  286.  
  287.