PC Toledo

Código: Selecionar todos

'news://news.xharbour.org/xHarbour.Spanish.Portuguese

Código: Selecionar todos

Autor: Renato Benedetti

// abaixo a rotina para substituir o DBEDIT, inclusive ela aproveita a mesma 
'função de usuario' escrita no dbedit

Procedure PCIDbEdit( nLI, nCI,nLF, nCF, aCpos, cFunc, aPic, aTit, cHeader, 
cColuna, cRodape, cColunaRodape )
LOCAL aob := {}
LOCAL i,X
LOCAL nReturn, nPic
LOCAL oB
LOCAL nMode := 0

If ( cColuna = NIL )
   cColuna := ' '
EndIf

If ( cHeader = NIL )
   cHeader := ''
EndIf

If ( cRodape = NIL )
   cRodape := ''
EndIf

For i := 1 to Len( aCpos )
   If aPic = NIL
      AAdd( aoB, { aCpos[ I ], aTit[ I ] } )
   Else
      If SubStr( aPic[ I ], 1, 1 ) = '@'
         nPic := 0
         For X := 1 to Len( aPic[ I ] )
            If SubStr( aPic[I], x, 1 ) = ' '
               nPic := Len( aPic[I] ) - X
            ElseIf nPic > 0
               Exit
            EndIf
         Next X
      Else
         nPic := Len( aPic[ I ] )
      EndIf

      If ( Len( aTit[ I ] ) > nPic )
         AAdd( aoB, { aCpos[ I ], aTit[ I ], Len( aTit[ I ] ), aPic[ I ] } )
      Else
         AAdd( aoB, { aCpos[ I ], aTit[ I ], nPic, aPic[ I ] } )
      EndIf
   EndIf
Next I

oB := PciTBrowseDB( nLI, nCI, nLF, nCF, aoB )
oB:freeze    := 0
oB:ColorSpec := SetColor()
oB:ColSep    := cColuna
oB:FootSep   := cRodape
oB:HeadSep   := cHeader

SetCursor( SC_NONE )

nMode := 0
cFunc := '{ |x,y| ' + AllTrim( cFunc ) + '( x, y ) }'
nReturn :=  Eval( &cFunc., nMode, oB:ColPos )
nKey := 0

Do While .T.
   If ( oB:ColPos <= oB:Freeze )
      oB:ColPos := oB:Freeze + 1
   EndIf

   //- - - - > Pinta Todas as Celulas da tela
   oB:ColorRect( { oB:RowPos, 1, oB:RowPos, oB:ColCount }, { 1, 1 } )
   ForceStable( oB )

   //- - - -> Pinta a Celula que esta o cursor
   oB:colorRect( { oB:RowPos, 1, oB:RowPos, oB:ColCount }, { 5, 2 } )
   oB:Hilite()

   If ( RecCount() = 0)
      If nMode = 0
         nMode := 3
         nKey := 1
      EndIf
   EndIf

   If ( oB:HitTop )
      If nMode = 0
         nMode := 1
      EndIf
   EndIf

   If ( oB:HitBottom )
      If nMode = 0
         nMode := 2
      EndIf
   EndIf

   If !( nKey = 0 )
      If (SetKey( nKey ) == NIL)
         nReturn :=  Eval( &cFunc., nMode, oB:ColPos )
         If ( nReturn = 0 )
            Exit
         EndIf

         If ( nReturn = 2 )
            If Deleted()
               DbSkip()
            EndIf
            oB:RefreshAll()
            nKey := nMode := 0
            Loop
         EndIf
      Else
         Eval( SetKey( nKey ) )
         If Deleted()
            DbSkip()
         EndIf
         oB:RefreshAll()
         nKey := nMode := 0
         Loop
      EndIf
   EndIf

   nMode := 0
   nKey := MyInkey(0)

   If !TBMoveCursor( oB, nKey )
      nMode := 4
   EndIf
EndDo


//- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  - - 
 - - - - - - - -
Procedure PciTBrowseDB( nTop, nLeft, nBottom, nRight, tb )
Local i, o, Column

If Len( tb ) = 0
   Mens_Erro("Erro de Parametro","Objetos do TBrowse Vazio",,.f.)
   Return( Nil )
EndIf

o := TBrowseDB( nTop, nLeft, nBottom, nRight )

For i = 1 To Len( tb )
    If Len( AllTrim( tb[ i,1] ) ) = 0
       Mens_Erro("Tabela do Browse Invalida","Existe um Campo Vazio na 
Tabela do Browse",,.f.)
       Return( Nil )
    EndIf

    If Len( AllTrim( tb[ i, 2] ) ) = 0
       tb[ i, 2 ] := tb[ i, 1 ]
    EndIf

    If Len( tb[ i ] ) >= 3 .and. ValType( tb[ i, 3 ] ) != 'N'
       Mens_Erro( "Tamanho Inv lido","Existe um Item com o Campo Tamanho 
Invalido",,.f.)
       Return( Nil )
    EndIf

    Column := TBColumnNew()
    Column:Heading := tb[ i, 2 ]
    If Len( tb[ i ] ) >= 4
       Column:Block   := &( " { || Transform( " + tb[ i, 1 ] + ",'" + 
StrTran( tb[ i, 4 ], '"', " " ) + "' ) } " )
       Column:Cargo   := { FieldBlock( '"' + tb[ i, 1 ] + '"' ), '"' + tb[ 
i, 4 ] + '"'}
    Else
       Column:Cargo   := { FieldBlock( '"' + tb[ i, 1 ] + '"' ), "" }
       Column:Block   := &( " { || " + tb[ i, 1 ] + " } " )
    EndIf

    If Len( tb[ i ] ) >= 3
       Column:Width := tb[ i, 3 ]
    EndIf

    o:AddColumn( Column )
Next i

Return( o )

*- - - - - - - - - - - - - - - - - - - - - - - - - -  - - - - - - -  - - - -
*- - - -> funcao do PciTBrowse
Function ForceStable( obj )

DispBegin()
obj:ForceStable()
DispEnd()

Return

//*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/
*-----------------------------------------------------------------------------
//- - - ->A funcao MyInkey() e a fun?"o inkey alterada 
////
*-----------------------------------------------------------------------------
//*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/

Function MyInkey( nSecs )
LOCAL nRet        := 0
LOCAL nDescTela   := 0
LOCAL mRow, mColw
LOCAL nTime, nTELADES, tel_savescreen

If nSecs == Nil
   nRet := InKey()
Else
   nTempProt := wTimTel * 60
   If nTempProt <= 0
      nTempProt := 1
   EndIf
   nDescTela := nTime := Seconds()
   While ( nRet == 0 ) .and. IIf ( nSecs > 0, ( Seconds() - nTime ) < nSecs, 
.T. )
      nRet := Inkey(IIf(nSecs>0 .and. nSecs < nTempProt, nSecs, nTempProt))
      Do Case
         Case nRet == K_ALT_C  // Abortar o Sistema
            r_AltC()

         Case nRet = 0
            BasMsgUs->( DBSetOrder( 2 ) )
            BasMsgUs->( DBSeek( wCodusu + 'N', .T. ) )
            If BasMsgUs->( Eof() )
               BasMsgUs->( DBSkip( -1 ) )
            EndIf
            If BasMsgUs->( !Bof() ) .And. BasMsgUs->( !Eof() ) .And. ;
               BasMsgUs->Usuario = wCodUsu .And. BasMsgUs->Lido = 'N'
               aRead_A_Message := .T.
               GetSalCor := SetColor()
               Set   Color To &wCor2*/&wCor1
               Set Color To w+/b
               @ MaxRow(), 59 + Len( AllTrim( wCodUsu ) ) + 3 Say 
'CTRL+F8=MSG'
               Set Color to &GetSalCor.
               Tone( 50, 3 )
            EndIf

            If ( Seconds() - nDescTela ) > nTempProt
               If wprotel = "S"
                  Save Screen to Tel_SaveScreen
                  mRow  := Row()
                  mColw := Col()
                  If (Day(Date()) % 2) = 0
                     ProtTela()
                  Else
                     Prot_Clock()
                  EndIf
                  Restore Screen from Tel_SaveScreen
                  @ mRow, mColw Say ""
               EndIf
               nDescTela := SECONDS()
            EndIf
      EndCase
   EndDo
EndIf

Return( nRet )


*- - - - - - - - - - - - - - - - - - - - - - - - - -  - - - - - - -  - - - -
*- - - -> funcao do PCITBrowse
Function TBMoveCursor( o, nKey )
LOCAL nFound
/*
Static aKeys := { K_DOWN      , { | obj | obj:down() },;
                  K_UP        , { | obj | obj:up() },;
                  K_PGDN      , { | obj | obj:pageDown() },;
                  K_PGUP      , { | obj | obj:pageUp() },;
                  K_CTRL_PGUP , { | obj | obj:goTop() },;
                  K_CTRL_PGDN , { | obj | obj:goBottom() },;
                  K_RIGHT     , { | obj | obj:right() },;
                  K_LEFT      , { | obj | obj:left() },;
                  K_HOME      , { | obj | obj:home() },;
                  K_END       , { | obj | obj:end() },;
                  K_CTRL_LEFT , { | obj | obj:panLeft() },;
                  K_CTRL_RIGHT, { | obj | obj:panRight() },;
                  K_CTRL_HOME , { | obj | obj:panHome() },;
                  K_CTRL_END  , { | obj | obj:panEnd() } }

nFound := AsCan( aKeys, nKey )
If (nFound != 0)
   Eval( aKeys[++nFound], o )
EndIf
*/

nFound := o:ApplyKey( nKey )

/*If nFound = TBR_EXIT  // Desconsiderar o ESC tambem
   nFound := 0
EndIf
*/

Return( nFound = 0 )