DEFINE  APOSTROFE               34
DEFINE  BANKNUMBER              10
DEFINE  FIRSTROW                5

DEFINE  GD_VERTICAL_SLIDER      0

DEFINE  GD_TITLE                5
DEFINE  GD_LISTX1               188
DEFINE  GD_LISTY1               23
DEFINE  GD_LISTX2               374
DEFINE  GD_LISTY2               208
DEFINE  GD_APPEND_BUTTON       4
DEFINE  GD_CYCLE               3
DEFINE  GD_OTITLE              1
DEFINE  GD_AUTHOR              2
DEFINE  GD_RELDATE             6
DEFINE  GD_SORT                7
DEFINE  GD_VIEW                8
DEFINE  DEFWINDOW              1
DEFINE  VERLEN                  21

Gui Amiga Os
Request Wb
ver$="$VER: BookShelf 1.0 (2001.11.10)"
ap$=chr$(#APOSTROFE)
_view=1
O_EVENT=true
Global ap$, MEZO, _LOCALE

Load "BookShelf.abk",#BANKNUMBER
Gui Mouse Mode 1
Amos To Back
Gui Sensitive Off
Gui Mouse Mode 1

Gui Open 1,1,10
Gui Writing %001

 Lib Open 1,"locale.library",0
 Areg(0)=0
 _LOCALE=Lib Call(1,Lvo("OpenLocale"))

list_len=(#GD_LISTX2-#GD_LISTX1)/Gui X Font
list_tag_h=(#GD_LISTY2-#GD_LISTY1)/(Gui Y Font+4)

Db Use "Book.dbf"

rlist_row=(#GD_LISTY2-#GD_LISTY1)/Gui Y Font-1
Gosub dbf_setslider
Gosub dbf_rlist

For I=#GD_OTITLE To #GD_SORT
    Gui Set #DEFWINDOW,I,-1,1
Next I

Repeat

  If O_EVENT
        EV=Gui Wait
        WIN=Gui Window
        CODE=Gui Code
  End If

  O_EVENT=True

  If WIN=1

        If EV=#GD_APPEND_BUTTON
                a=Db Recno
                Db Append Blank
                Gui Set$ #DEFWINDOW,#GD_TITLE,""
                Gui Set$ #DEFWINDOW,#GD_OTITLE,""
                Gui Set$ #DEFWINDOW,#GD_AUTHOR,""
                Gui Set #DEFWINDOW,#GD_RELDATE,0,2001
                Gui Set #DEFWINDOW,#GD_CYCLE,0,0
                _select=Db recno
                Db Goto a
                Gosub dbf_rlist
                Gosub dbf_setslider
        Else If EV=#GD_VIEW
                _view=Gui Read (#DEFWINDOW,#GD_VIEW)+1
                Db Goto 1
                Gui Ink 0
                Gui Bar #GD_LISTX1,#GD_LISTY1+5 To #GD_LISTX2,#GD_LISTY2
                Gosub dbf_rlist
        Else If EV=#GD_SORT
                a=Db Recno
                MEZO=Gui Read (#DEFWINDOW,#GD_SORT)+1
                QUICK[1,Db Reccount]
                Db Goto a
                Gosub dbf_rlist
        Else If EV=#GD_VERTICAL_SLIDER and Db State
                a=Code+1
                If a<>Db Recno and Db Reccount>0
                        Db Goto a
                        Gosub dbf_rlist
                End If
        Else If EV=#GD_TITLE or EV=#GD_OTITLE or EV=#GD_AUTHOR
                a=Db Recno
                Db Goto _select
                a$=Gui Read$ (#DEFWINDOW,EV)
                If EV=#GD_TITLE
                   If a$<>Db Get$(1)
                       Db Put$ a$,1
                   End If
                Else If EV=#GD_OTITLE
                   If a$<>Db Get$(2)
                       Db Put$ a$,2
                   End If
                Else If EV=#GD_AUTHOR
                   If a$<>Db Get$(3)
                       Db Put$ a$,3
                   End If
                End If
                Db Goto a
                Gosub dbf_rlist
        Else If EV=#GD_RELDATE or EV=#GD_CYCLE
                a=Db Recno
                Db Goto _select
                b=Gui Read (#DEFWINDOW,EV)
                If EV=#GD_RELDATE
                   If b<>Db Get(4)
                       Db Putn b,4
                   End If
                Else If EV=#GD_CYCLE
                   If b<>Db Get(5)
                       Db Putn b,5
                   End If
                End If
                Db Goto a
                Gosub dbf_rlist
        Else If EV=-11
'                                       left click
                _slider=Db Recno
                _WX=Gui Mouse Wx
                _WY=Gui Mouse Wy
                If _WX>#GD_LISTX1 and _WX<#GD_LISTX2
                    If _WY>#GD_LISTY1 and _WY<#GD_LISTY2
                        _select=(_WY-#GD_LISTY1)/Gui Y Font+Gui Read (#DEFWINDOW,#GD_VERTICAL_SLIDER)
                        If _select>0 and _select<=Db Reccount
                            For I=#GD_OTITLE To #GD_SORT
                                Gui Set #DEFWINDOW,I,-1,0
                            Next I
                            Db Goto _select
                            Gosub dbf_read
                            Db Goto _slider
                        End If
                    End If
                End If
        End If
  End If

Until EV=-1 and WIN=1

VEG:

x=Gui Close (1)
Erase 10

If Db Opencount
   For I=1 To Db Opencount
      Db Select First 
      Db Close 
   Next I
End If 
If _LOCALE
        Areg(0)=_LOCALE
        X=Lib Call(1,Lvo("CloseLocale"))
        Lib Close 1
End If
End



dbf_read:
    Gui Set$ #DEFWINDOW,#GD_TITLE,Db Get$(Db Field("title"))
    Gui Set$ #DEFWINDOW,#GD_OTITLE,Db Get$(2)
    Gui Set$ #DEFWINDOW,#GD_AUTHOR,Db Get$(3)
    Gui Set #DEFWINDOW,#GD_RELDATE,0,Db Get(4)
    Gui Set #DEFWINDOW,#GD_CYCLE,0,Db Get (5)
Return

dbf_rlist:
'Fill the14 text gadget with record data starting from record FI to list_len char
        Db Cutspace Off
        a=Db Recno
        For r=1 to rlist_row
                a$=Db Get$(_view)
                Gui Text #GD_LISTX1+2,#GD_LISTY1+r*Gui Y Font,Left$(a$,23)
                Exit If Db Recno=Db Reccount
                Db Skip
        Next r
        Db Goto a
        Db Cutspace On
Return

dbf_setslider:
Gui Set #DEFWINDOW,#GD_VERTICAL_SLIDER,0,Max(Db Recno-1,0)
Gui Set #DEFWINDOW,#GD_VERTICAL_SLIDER,1,Max(Db Reccount-rlist_row-1,Db Reccount)
Gui Set #DEFWINDOW,#GD_VERTICAL_SLIDER,2,rlist_row
Return


Procedure QUICK[BAL,JOBB]
   I=BAL : J=JOBB
   Db Goto(I+J)/2 : Inc _GOTO
   KOZEPKULCS$=Db Get$(MEZO)

   While I<=J

      Db Goto I
      I$=Db Get$(MEZO)
      Db Goto J
      J$=Db Get$(MEZO)

      Do
         STRNCMP[I$,KOZEPKULCS$]
         Exit If Param>=0
         Inc I
         Db Goto I
         I$=Db Get$(MEZO)
       Loop

      Do
         STRNCMP[J$,KOZEPKULCS$]
         Exit If Param<=0
         Dec J
         Db Goto J
         J$=Db Get$(MEZO)
      Loop

      If I<=J
         Db Swap I,J
         Inc I
         Dec J
      End If

   Wend

   If BAL<J
      Proc QUICK[BAL,J]
   End If

   If I<JOBB
      Proc QUICK[I,JOBB]
   End If

End Proc

Procedure STRNCMP[STRING1$,STRING2$]
   Areg(0)=_LOCALE
   Areg(1)=Varptr(STRING1$)
   Areg(2)=Varptr(STRING2$)
   Dreg(0)=-1
   Dreg(1)=2
   X=Lib Call(1,Lvo("StrnCmp"))
End Proc [X]