en GUI, Harbour

DBF Viewer 2020 – Código Fuente I

2015-03-25_160535

/*
 *
 * Program to view DBF files using standard Browse control
 * Miguel Angel Juárez A. - 2009-2015 MigSoft <mig2soft/at/yahoo.com>
 * Includes the code of Grigory Filatov <[email protected]>
 * and Rathinagiri <[email protected]>
 *
 */

#include "oohg.ch"
#include "dbstruct.ch"
#include "fileio.ch"
#include "dbuvar.ch"

*------------------------------------------------------------------------------*
Function Main( cDBF )
*------------------------------------------------------------------------------*

   REQUEST DBFNTX
   REQUEST DBFCDX, DBFFPT
   RDDSETDEFAULT( "DBFCDX" )
   SET AUTOPEN OFF

   Publicar()

   Load window oWndBase

   ON KEY F3 OF oWndBase ACTION AutoMsgInfo( aFiles, "aFiles" )
   ON KEY F4 OF oWndBase ACTION AutoMsgInfo( nRecCopy, "nRecCopy" )
   ON KEY F5 OF oWndBase ACTION AutoMsgInfo( ( Alias() )->( Select() ), "Select()" )
   ON KEY F6 OF oWndBase ACTION AutoMsgInfo( ( Alias() )->( Dbf() ), "Dbf()" )
   ON KEY F7 OF oWndBase ACTION AutoMsgInfo( ( Alias() )->( Used() ), "Used()" )

   If PCOUNT() > 0
      OpenBase( cDBF )
   Else
      OpenBase( "" )
   Endif

   oWndBase.Center
   oWndBase.Activate

Return Nil

*------------------------------------------------------------------------------*
Procedure Publicar()
*------------------------------------------------------------------------------*

    Public nAltoPantalla  := GetDesktopHeight() + GetTitleHeight() + GetBorderHeight()
    Public nAnchoPantalla := GetDesktopWidth()
    Public nRow           := nAltoPantalla  * 0.10
    Public nCol           := nAnchoPantalla * 0.10
    Public nWidth         := nAnchoPantalla * 0.95
    Public nHeight        := nAltoPantalla  * 0.85
    Public _OOHG_PRINTLIBRARY
    Public cBaseFolder, aTypes, aNewFile := {}, aFtype := {}, aCtrl := {}
    Public nCamp, aEst    := {}, aNomb := {}, aJust := {}, aLong := {}, i, cBase
    Public cFont          := 'MS Sans Serif'
    Public nSize          := 8 , Nuevo := .F.
    Public nRecCopy       := {}
    Public aArea          := {}
    Public aFiles         := {}
    Public nArea          := 0
    Public nBrow          := 0
    Public nBase          := 0
    Public nRecSel        := 0
    Public nPage          := 1
    Public aFntClr        := {0,0,0}
    Public aBackClr       := {255,255,255}
    Public aSearch        := {}, aReplace := {}
    Public nSearch        := 1, nReplace := 1, nColumns := 1
    Public lMatchCase     := .F., lMatchWhole := .F.
    Public nDirect        := 3, cDateFormat := "DD.MM.YYYY"
    Public _DBULastPath   := ''
    Public VERSION        := "v."+substr(__DATE__,3,2)+"."+right(__DATE__,4)
    HB_LANGSELECT( "EN" )
    DECLARE WINDOW Form_Query
    DECLARE WINDOW Form_Find
    DECLARE WINDOW _DBUcreadbf
    DECLARE WINDOW Form_Prop
    DECLARE WINDOW oWndBase

Return

*------------------------------------------------------------------------------*
Procedure OpenBase( cDBF )
*------------------------------------------------------------------------------*
   local nn, aTemp := {}

   cBaseFolder := GetStartupFolder()
   LoadArchIni(cBaseFolder+'\')

   If Empty(cDBF) .OR. ValType ( cDBF ) == 'U'
      If !IsControlDefined(Tab_1,oWndBase)
         oWndBase.Image_1.Show
      Endif
      aTypes   := { {'Database files (*.dbf)', '*.dbf'} }
      aTemp    := iif( !Empty(aNewFile),aNewFile[1],"")
      aNewFile := GetFile( aTypes, 'Select database files', CurDir(), .T. )
      If Empty(aNewFile)
         Aadd( aNewFile, aTemp )
      Endif
   Else
      AAdd( aNewFile, cDBF )
   Endif

   IF !Empty(aNewFile)
       For nn := 1 to Len(aNewFile)
           If !Empty(aNewFile[nn]) .AND. Upper(Right(aNewFile[nn],3))="DBF"
                  If DB_Open( aNewFile[nn] )
                     _DBULastPath := hb_Curdrive()+':\'+CurDir()+'\'

                     If Used(aNewFile[nn])

                        Aadd( aFiles, aNewFile[nn] )
                        oWndBase.Title := PROGRAM+VERSION+COPYRIGHT+aNewfile[nn]

                        ArmMatrix()

                        cAreaPos  := AllTrim( Str( ( Alias() )->( Select( oWndBase.Tab_1.caption( oWndBase.Tab_1.value ) ) ) ) )
                        cBrowse_n := "Browse_"+cAreaPos

                        oWndBase.&(cBrowse_n).ColumnsAutoFitH
                        oWndBase.&(cBrowse_n).SetFocus             // Ilumina barra en primer registro
                        oWndBase.&(cBrowse_n).GoTop
                     Endif

                  Endif

           Endif
       Next nn

   Else
      cBase := ''
      MuestraRec()
      oWndBase.Title := PROGRAM+VERSION+COPYRIGHT
      If !IsControlDefined(Tab_1,oWndBase)
         oWndBase.Image_1.Show
      Endif
   Endif

Return

*------------------------------------------------------------------------------*
Procedure ArmMatrix()
*------------------------------------------------------------------------------*
   Local i
   cBase := Alias() ; nCamp := Fcount() ; aEst  := DBstruct() ; aCtrl := {}
   aNomb := {'iif(deleted(),0,1)'} ; aJust := {0} ; aLong := {0} ; aFtype:={}
   cCtrl := "{},"

   For i := 1 to nCamp
       Aadd(aNomb,aEst[i,1])                             // Carga el nombre de campo
       Aadd(aJust,iif(aEst[i,2]=='N',1,0))               // Justifica a la izquierda o derecha de acuerdo al tipo de dato
       cCtrl += AssiCtrlBrw( aEst[i,2], aEst[i,3],aEst[i,4],FieldName(i) )   // control por tipo de campo
       Aadd(aLong,Max(100,Min(160,aEst[i,3]*14)))        // Asigna la longitud del dato en el browse
       If     aEst[i,2]=="I" .OR. aEst[i,2]=="W" .OR. aEst[i,2]=="Y" .OR. aEst[i,2]=="B"
              aEst[i,2]:= 'N'
       ElseIf aEst[i,2]=="G" .OR. aEst[i,2]=="P"
              aEst[i,2]:= 'M'
       ElseIf aEst[i,2]=="@" .OR. aEst[i,2]=="T"
              aEst[i,2]:= 'D'
       Endif
       Aadd(aFtype, aEst[i,2])                           // Carga el tipo de campo
   Next

   aCtrl :=  &("{"+cCtrl+"}")                            // Asigna controles por tipo de campo
   CreaBrowse( cBase, aNomb, aLong, aJust, aFtype, aCtrl )

Return

*------------------------------------------------------------------------------*
Function DB_Open( cFileDBF )
*------------------------------------------------------------------------------*
   lSuc := .F.
      TRY
          If ! ( DelExt(GetName(cFileDBF)) )->( Used() )
             Use ( cFileDBF ) New
             lSuc := .T.
             Aadd( aArea, ( Alias() )->( Select() ) )
             nArea++
             nBase++
          Endif
      CATCH loError
          MsgInfo("Unable open file: "+cFileDBF, PROGRAM+" TRY")
      END
Return (lSuc)

*---------------------------------------------------------------------*
FUNCTION GetName(cFileName)
*---------------------------------------------------------------------*
  LOCAL cTrim  := ALLTRIM(cFileName)
  LOCAL nSlash := MAX(RAT('\', cTrim), AT(':', cTrim))
  LOCAL cName  := IF(EMPTY(nSlash), cTrim, SUBSTR(cTrim, nSlash + 1))
RETURN( cName )

*---------------------------------------------------------------------*
FUNCTION DelExt(cFileName)
*---------------------------------------------------------------------*
  LOCAL cTrim  := ALLTRIM(cFileName)
  LOCAL nDot   := RAT('.', cTrim)
  LOCAL nSlash := MAX(RAT('\', cTrim), AT(':', cTrim))
  LOCAL cNamew := IF(nDot <= nSlash .OR. nDot == nSlash + 1, ;
                  cTrim, LEFT(cTrim, nDot - 1))
RETURN( cNamew )

*------------------------------------------------------------------------------*
Function CreaBrowse( cBase, aNomb, aLong, aJust, aFtype, aCtrl )
*------------------------------------------------------------------------------*
    aHdr       := aClone(aNomb)
    aJst       := aClone(aJust)
    aHdr[1]    := ""
    aLong[1]   := 20
    aCabImg    := aClone(VerHeadIcon(aFtype))

    oWndBase.Image_1.Hide

    If IsControlDefined(Tab_1,oWndBase)
       NuevoTab()
    Else
       DEFINE TAB Tab_1 OF oWndBase AT 40,15 WIDTH ooWndBase:Clientwidth  - 30 HEIGHT ooWndBase:Clientheight - 70 ;
       VALUE 1 FONT "Arial" SIZE 9 FLAT ON CHANGE SeleArea()
           PAGE cBase IMAGE "Main1"
                MakeBrowse()
           END PAGE
       END TAB

       oTab := GetControlObject("Tab_1","oWndBase")
       oTab:Anchor := "TOPLEFTBOTTOMRIGHT"

    Endif

    SetHeaderImages()

Return Nil

*------------------------------------------------------*
Procedure MakeBrowse()
*------------------------------------------------------*
   cAreaPos  := AllTrim( Str( ( Alias() )->( Select() ) ) )
   cBrowse_n := "Browse_"+cAreaPos

           If !IsControlDefined(&cBrowse_n,oWndBase)

                  @ 26,0 BROWSE &cBrowse_n              ;
                     OF oWndBase                        ;
                     WIDTH  ooWndBase:Clientwidth  - 32  ;
                     HEIGHT ooWndBase:Clientheight - 100 ;
                     HEADERS aHdr                       ;
                     WIDTHS aLong                       ;
                     WORKAREA &( Alias() )              ;
                     FIELDS aNomb                       ;
                     VALUE 0                            ;
                     FONT "MS Sans Serif" SIZE 8        ;
                     TOOLTIP ""                         ;
                     ON CHANGE { || MuestraRec() }      ;
                     IMAGE { "br_no", "br_ok" }         ;
                     JUSTIFY aJst                       ;
                     COLUMNCONTROLS aCtrl               ;
                     LOCK                               ;
                     EDIT                               ;
                     INPLACE                            ;
                     DELETE                             ;
                     ON HEADCLICK Nil                   ;
                     HEADERIMAGES aCabImg               ;
                     DOUBLEBUFFER                       ;
                     NAVIGATEBYCELL                     ;
                     SELECTEDCOLORS { WHITE, {65,105,225},           ;           // Cursor Fuente/Fondo
                                      WHITE, {128,128,128},          ;           // Cursor ventana sin foco Fuente/Fondo
                                      {106,90,205}, {135,206,250},   ;           // Fila resaltada  Fuente/Fondo
                                      {105,105,105},{220,220,220} }              // Fila resaltada click en columna  Fuente/Fondo

           Endif

   oBrowse := GetControlObject(cBrowse_n,"oWndBase")
   oBrowse:Anchor := "TOPLEFTBOTTOMRIGHT"

   nBrow++

Return


*------------------------------------------------------*
Procedure NuevoTab() // Cortesía: Ciro Vargas Clemow
*------------------------------------------------------*
   cAreaPos  := AllTrim( Str( aArea[nBase] ) )
   cBrowse_n := "Browse_"+cAreaPos

   oTab := GetControlObject("Tab_1","oWndBase")

      oTab:AddPage ( ( Alias() )->( Select() ), Alias() )
      nPage++
      oTab:Value := ( Alias() )->( Select() )

      MakeBrowse()

      oTab:AddControl( cBrowse_n, ( Alias() )->( Select() ), 26, 0 )

Return