INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Get Data from Database

Get Data from Database

(OP)
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 ?  

RE: Get Data from Database

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

RE: Get Data from Database

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

RE: Get Data from Database

(OP)
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

RE: Get Data from Database

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.

RE: Get Data from Database

(OP)
Ok thanks I will test again.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close