Get Data from Database

lzulli · May 25, 2007

How can I GET a record from an Indexed Database while I visualize from small window the data that mach my keystrokes.
Example: If I stroke the number 1 in my Get, all the records of my database that starts from number 1 appears in the indexed order on the popup window, then I stroke the second number 2 (result 12) and all the records starting with numbers 12 appear and so on until I stroke the Enter key to terminate the Get. If possible also navigate up and down in this popup window to select the desired record.
Can somebody give me a sample of this program ?

sboomer · May 27, 2007

Here is a set of functions that I use to search a alphabetic db of patients for an electronic medical record.
The first search is on last name and after pressing / or , or . will switch to first name than initial.
Although you are searching numbers and they are stored as characters, you can modify the code to exclude csearch1 and cshearch2. If the data is stored as numeric wou will have to make changes due to data type change.

The numbers in the browser() call define the size of the Tbrowse which yu can alter to suit your layout.

Code:

to call function

      Browser( 9, 14, 19, 65, in_key)


*-------------------
FUNCTION Browser( nTop, nLeft, nBottom, nRight, nInKey)
*-------------------
local oColumn
local oBrowse
local nKey
local cString
local nCursSave
local cDbScrn

private lExitRequested := .F.
private cSearch        := ''
private cSearch1       := ''
private cSearch2       := ''
private lSep           := .F.
private lSep1          := .F.
private cSepChar       := ' '

private nTp := nTop - 2, nLft := nLeft + 1

default nInKey TO 1

nRight += 2

setcursor(1)
keyboard chr(nInKey)

pushdbf()
dbselectarea('pntreg')
nsaveorder := indexord()

if nSaveorder != 2

  set order to 2
  keyboard chr(nInKey)

endif

pushscreen()
cSaveColor := setcolor('W+/B,R/W,,,N/BG')

@nTop - 3,nLeft - 1,nTop - 1,nRight + 1 box 'ÉÍ»º¼ÍÈº ' color 'W+/N'
@nTop - 1,nLeft - 1,nBottom + 1,nRight + 1 box 'ÌÍ¹º¼ÍÈº ' color 'W+/N'

// Set cursor off
nCursSave := setcursor(0)

// make new browse object
oBrowse := TBrowseDB(nTop, nLeft, nBottom, nRight)

// make new column objects and add to browse object
oColumn := TBColumnNew(' Last Name', {|| pntreg->lName})
oBrowse:addColumn(oColumn)

oColumn := TBColumnNew(' First', {|| pntreg->fname})
oBrowse:addColumn(oColumn)

oColumn := TBColumnNew('I', {|| pntreg->pntinit})
oBrowse:addColumn(oColumn)

oColumn := TBColumnNew('Account#', {|| pntreg->idnum})
oBrowse:addColumn(oColumn)

oColumn := TBColumnNew('  DOB', ;
  {|| dtoc(pntreg->dob)})
oBrowse:addColumn(oColumn)

oBrowse:skipBlock := {|n| SkipFor( n)}

oBrowse:colSep  := '³ '
oBrowse:headSep := 'ÑÍ'

// position at first name
oBrowse:goTopBlock := {|| dbseek(chr(nInKey), .T.)}

oBrowse:colorSpec := 'W+/N,N/W,W/N,N/W'
//oBrowse:colorSpec := 'W+/N,R/W,R/N,GR+/W+' // Wed 09-29-2004SDB

oBrowse:gotop()

while !lExitRequested                       // enter main browse loop

  oBrowse:colorRecT({oBrowse:rowpos, oBrowse:leftVisible, ;
                     oBrowse:rowpos, oBrowse:colCount}  , ;
                     {1,2})

  while !oBrowse:stable
    oBrowse:stabilize()
  enddo

  if (oBrowse:stable)

    oBrowse:colorRecT({oBrowse:rowpos, oBrowse:leftVisible, ;
                      oBrowse:rowpos, oBrowse:colCount}   , ;
                      {2,1})

    oBrowse:colorRecT({oBrowse:rowpos, oBrowse:leftVisible, ;
                      oBrowse:rowpos, oBrowse:colpos}     , ;
                      {4,1})

    nKey := inkey(0)

  else

    nKey := inkey(0)

  endif

  do case

    case nKey == K_BS

      do case

        case !lSep .and. !lSep1

          cSearch := left(cSearch,len(cSearch) - 1)

          if len(cSearch) == 0

            @nTp,nLft say padr(cSearch,20,'°') color 'W+/RB'
            search(oBrowse,@cSearch,@cSearch1,@cSearch2)
            dbseek('A', .T.)
            oBrowse:stabilize()

          else
            
            @nTp,nLft say padr(cSearch,20,'°') color 'W+/RB'
            search(oBrowse,@cSearch,@cSearch1,@cSearch2)

          endif

        case lSep .and. !lSep1

          if notzero(len(cSearch1))

            cSearch1 := left(cSearch1,len(cSearch1) - 1)
            @nTp,nLft say padr(cSearch + cSepChar + cSearch1,20,'°') color 'W+/RB'

          else

            oBrowse:left()
            lSep := .F.
            @nTp,nLft say padr(cSearch,20,'°') color 'W+/RB'

          endif

          oBrowse:gotop()
          search(oBrowse,@cSearch,@cSearch1,@cSearch2)

        case lSep .and. lSep1
          do case 
            case notzero(len(cSearch2))
              cSearch2 := ""
              @nTp,nLft say padr(cSearch + cSepChar + cSearch1 + cSepChar,20,'°') color 'W+/RB'

            case iszero(len(cSearch2))
              oBrowse:left()
              lSep1 := .F.
              @nTp,nLft say padr(cSearch + cSepChar + cSearch1,20,'°') color 'W+/RB'
          endcase

          oBrowse:gotop()
          search(oBrowse,@cSearch,@cSearch1,@cSearch2)

      endcase

    case nKey == K_ENTER

      if left(pntreg->lName, 1) == '*'

        cLname := trim(right(pntreg->lname, (len(pntreg->lname) - 1)))

      else

        cLname := trim(pntreg->lname)

      endif

      cInitName := substr(pntreg->fname,1,1) + ' ' + trim(cLname)

      cFullname := trim(pntreg->fname) + ;
        if(empty(pntreg->pntinit),' ',' ' + pntreg->pntinit + ' ') ;
           + trim(cLname)

      cLastName := cLname

      iif(!empty(pntreg->dob),nPntAge := dateasage(pntreg->dob),0)
      cIdnum    := pntreg->idnum
      box_byte  := pntreg->box
      cGender   := pntreg->gnder
      acct_bal  := pntreg->acctbal
      dPntDob   := pntreg->dob
      lNewPnt   := .f.
      e_ppayid  := pntreg->ppayid

      //ÄÄ set special account flag ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
      if(pntreg->accttype != 'P',lIsSpecial := .T.,lIsSpecial := .F.)

      if !lIsspecial
        e_mark    := pntreg->emccode   // Thu 07-03-2003SDB
        e_place   := '11'              // Thu 07-03-2003SDB
        e_date    := date()

      endif

      lNoPnt := .f.
      lExitRequested := .T.

    case aScan(aKeys,upper(chr(nKey))) != 0 ;
         .and. lSep .and. lSep1

      cSearch2 := cSearch2 + upper(chr(nKey))
      @nTp,nLft say padr(cSearch + cSepChar + cSearch1 + cSepChar + cSearch2,20,'°') color 'W+/RB'
      search(oBrowse,@cSearch,@cSearch1,@cSearch2)

    case (aScan(aKeys,(upper(chr(nKey)))) != 0) ;
         .and. lSep .and. !lSep1

      cSearch1 := cSearch1 + upper(chr(nKey))
      @nTp,nLft say padr(cSearch + cSepChar + cSearch1,20,'°') color 'W+/RB'
      search(oBrowse,@cSearch,@cSearch1)

    case aScan(aKeys,upper(chr(nKey))) != 0 ;
         .and. !lSep .and. !lSep1

      if nKey = 42 .and. (len(cSearch) == 0)

        cSearch := cSearch + chr(nKey)

      else

        cSearch := cSearch + upper(chr(nKey))

      endif

      @nTp,nLft say padr(cSearch,20,'°') color 'W+/RB'
      search(oBrowse,@cSearch)

    case (upper(chr(nKey)) $ SEPERATOR1) .and. !lSep
         lSep     := .T.
      @nTp,nLft say padr(cSearch + cSepChar ,20,'°') color 'W+/RB'
      oBrowse:right()

    case (upper(chr(nKey)) $ SEPERATOR1) .and. lSep
         lSep1     := .T.
      oBrowse:right()
      @nTp,nLft say padr(cSearch + cSepChar + cSearch1 + cSepChar,20,'°') color 'W+/RB'

    case nKey == K_ESC
      lNoPnt := .T.
      lExitrequested := .T.

    otherwise
      browserkey(nKey,obrowse)

  endcase
enddo


set order to nsaveorder                     // Restore saved screen stuff
popdbf()
setcursor(nCursSave)
popscreen()

setcolor(cSaveColor)

RETURN cIdnum

//ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
function ForceStable( oBrowse )
//ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
while !oBrowse:stabilize() ; enddo

return .T.

//ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
function skipfor(n)
//ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

local nMoved := 0

if ( lastrec() == 0 )

  return (nMoved)

endif

do case

  case ( n == 0 )
    skip 0

  case ( n > 0 )
    do while ( nMoved <= n) .and. !eof()
      skip 1
      nmoved++
    enddo

    // move back to last record that is in the range
    skip -1
    nMoved--

  case ( n < 0 )
    do while ( nMoved > n )
      skip -1
      if bof()
        exit
      endif
      nmoved--
    enddo

endcase

return (nMoved)

//ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
static function browserkey(nKey,oTbr)
//ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
local lKeyhandled := .T.

do case
  case nKey == K_UP        ;   oTbr:up()
  case nKey == K_DOWN      ;   oTbr:down()
  case nKey == K_LEFT      ;   oTbr:left()
  case nKey == K_RIGHT     ;   oTbr:right()
  case nKey == K_PGUP      ;   oTbr:pageUp()
  case nKey == K_PGDN      ;   oTbr:pageDown()
  case nKey == K_HOME      ;   oTbr:home()
  case nKey == K_END       ;   oTbr:end()
  case nKey == K_CTRL_PGUP ;   oTbr:goTop()
  case nKey == K_CTRL_PGDN ;   oTbr:goBottom()
  case nKey == K_CTRL_LEFT ;   oTbr:panLeft()
  case nKey == K_CTRL_RIGHT;   oTbr:panRight()
  case nKey == K_CTRL_HOME ;   oTbr:panHome()
  case nKey == K_CTRL_END  ;   oTbr:panEnd()

endcase

return lKeyHandled

//ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
function search(oTbr,cSearch,cSearch1, cSearch2)
//ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
local xId := recno()

do case

  case !lSep .and. !lSep1

    if !dbseek(cSearch,.T.)
      tone(500,1)
      centerbox(cSearch + ' Not Found')
      INKEY(.52)
      centerbox()
      cSearch := left(cSearch,len(cSearch) - 1)
      @nTp,nLft say padr(cSearch, 20, '°') color 'W+/RB'
      dbgoto(xId)

    else

      oTbr:refreshall()

    endif
  
  case lSep .and. !lsep1
  
    dbseek(cSearch,.T.)

    if notzero(len(cSearch1))

      locate for lname = csearch .and. fname = csearch1 WHILE Lname = csearch
  
      if !found()                             // if gone by lname skip -1
        tone(500,1)
        centerbox(cSearch + ' ' + cSearch1 + ' Not Found')
        INKEY(.52)
        centerbox()
        cSearch1 := left(cSearch1,len(cSearch1) - 1)
        @nTp,nLft say padr(cSearch + cSepChar + cSearch1,20,'°') color 'W+/RB'
        dbgoto(xId)

      endif

    endif

    oTbr:refreshall()

  case lSep .and. lsep1 .and. !empty(cSearch2)

    locate for lname = csearch .and. fname = csearch1 .and. pntinit = cSearch2 ;

       WHILE Lname = csearch .and. fname = cSearch1
  
    if !found()                             // if gone by lname skip -1

      tone(500,1)
      centerbox(cSearch + ' ' + cSearch1 + ' ' + cSearch2 + ' Not Found')
      INKEY(.52)
      centerbox()
      cSearch2 := ''
      @nTp,nLft say padr(cSearch + cSepChar + cSearch1,20,'°') color 'W+/RB'
      dbgoto(xId)
    else

      oTbr:refreshall()

    endif

  case lSep .and. lsep1 .and. empty(cSearch2)

    dbseek(cSearch,.T.)

        locate for lname = csearch .and. fname = csearch1 WHILE Lname = csearch

    oTbr:refreshall()

endcase

return

Hope this can be of value to your project. If it is, I would like to have you version of the code.

Sam

lzulli · May 30, 2007

Thanks Sam, let me a few days to test it, I'm very busy now in other things.
Luc

lzulli · Jun 11, 2007

Hi Sam,
i test your program but I get 4 errors:

xHarbour Compiler build 0.99.50 (SimpLex)
Copyright 1999-2005,

http://www.xharbour.org

http://www.harbour-project.org/

Compiling 'BROWSER.PRG'...
BROWSER.PRG(28) Error E0030 Syntax error: "syntax error at 'NINKEY'"
BROWSER.PRG(417) Error E0030 Syntax error: "syntax error at 'LSEP'"
BROWSER.PRG(425) Error E0017 Unclosed control structure at line 354
BROWSER.PRG(428) Error E0017 Unclosed control structure at line 354
4 errors
No code generated

Pls check.
Luc

sboomer · Jun 11, 2007

The error at line 27 is expecting a key value. The following snippet will correct that error as function call expects a key value

Code:

private nTp := nTop - 2, nLft := nLeft + 1

//default nInKey TO 1
if empty(nInkey)
  inkey := 1
endif 
nRight += 2

The error at 425/428 is missing a semicolon (

to continue the line

Code:

  case lSep .and. lsep1 .and. !empty(cSearch2)
    locate for lname = csearch .and. fname = csearch1 .and. pntinit = cSearch2 ;
       WHILE Lname = csearch .and. fname = cSearch1

With these 2 changes, the code will compile as I have an obj file which I could send to you.

lzulli · Jun 23, 2007

Ok thanks I will test again.

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Get Data from Database

lzulli

Programmer

sboomer

Programmer

lzulli

Programmer

lzulli

Programmer

sboomer

Programmer

lzulli

Programmer

Similar threads

Part and Inventory Search

Sponsor