Click above to get retro games delivered to your door ever month!

// This sample shows how to create a tipical Database Management

//----------------------------------------------------------------------------//
//  FiveWin 1.0 - Ejemplos
//  (c) A.Linares, F.Pulp.n 1993
//
//  Construir con BUILD FwBrow
//  To build: BUILD FwBrow
//----------------------------------------------------------------------------//

// Una t.pica aplicaci.n de gesti.n
// Typical bussiness application

#include "FiveWin.ch"

static oWnd

//----------------------------------------------------------------------------//

function Main()

   local oBrush, oBar
   local cOldBmp := GetProfString( "Desktop", "WallPaper" )

   SetDeskWallPaper( "..\bitmaps\fivewin.bmp" )

   DEFINE BRUSH oBrush STYLE TILED       // FiveWin new predefined Brushes

   DEFINE WINDOW oWnd FROM 4, 4 TO 25, 75 ;
      TITLE FWVERSION + " - Browsing power" ;
      MENU BuildMenu() ;
      BRUSH oBrush

   DEFINE BUTTONBAR oBar OF oWnd

   DEFINE BUTTON FILENAME "..\bitmaps\OpenPrj.bmp" OF oBar ;
      ACTION OpenDbf() MESSAGE "Browse any DBF..."

   DEFINE BUTTON FILENAME "..\bitmaps\Exit.bmp" OF oBar ;
      ACTION If( MsgYesNo( "Do you want to End ?", "Please, Select" ), oWnd:End(), ) ;
      MESSAGE "End this session"

   DEFINE BUTTON FILENAME "..\bitmaps\Edit.bmp" OF oBar GROUP ;
      MESSAGE "Using a Browse with dynamic Bitmap selection" ACTION Clients()

   DEFINE BUTTON FILENAME "..\bitmaps\Ques2.bmp" OF oBar ;
      MESSAGE "How to get FiveWin 1.2" ACTION WinHelp( "Order.hlp" )

   SET MESSAGE OF oWnd TO FWCOPYRIGHT

   @ 4, 5 BITMAP FILENAME "..\bitmaps\Tutanka1.bmp" SIZE 180, 200 OF oWnd

   ACTIVATE WINDOW oWnd

   SetDeskWallPaper( cOldBmp )              // We restore old WallPaper...

return nil

//----------------------------------------------------------------------------//

function BuildMenu()

   local oMenu
   
   MENU oMenu
      
      MENUITEM OemToAnsi( "&Information" )
      MENU
         MENUITEM "&About..." ;
            ACTION MsgInfo( "(C) A.Linares, F.Pulp.n 1993", "FiveWin 1.2" ) ;
            MESSAGE OemToAnsi( "Some information about this demo" )
         SEPARATOR
         MENUITEM "&Exit demo..." ACTION ;
            If( MsgYesNo( "Do you want to end ?", "Please, Select" ), oWnd:End,) ;
            MESSAGE "End the execution of this demo"
      ENDMENU
      
      MENUITEM "&Clients Control" ACTION Clients()
      
      MENUITEM "&Utilities"
      MENU
         MENUITEM "&Calculator..." ACTION WinExec( "Calc" ) ;
            MESSAGE "Calling Windows Calculator"

         MENUITEM "C&alendar..."  ACTION WinExec( "Calendar" ) ;
            MESSAGE "Calling Windows Calendar"

         SEPARATOR

         MENUITEM "&Writing..."    ACTION WinExec( "Write" ) ;
            MESSAGE "Calling Windows Write"
      ENDMENU

   ENDMENU

return oMenu

//----------------------------------------------------------------------------//

function Clients()

   local oDlg
   local oLbx
   local aHBitMaps:= { ReadBitmap( 0, "..\bitmaps\Level1.bmp" ), ; // BitMaps de 14 x 32
                       ReadBitmap( 0, "..\bitmaps\Level2.bmp" ), ;
                       ReadBitmap( 0, "..\bitmaps\Level3.bmp" ), ;
                       ReadBitmap( 0, "..\bitmaps\Level4.bmp" ),;
                       ReadBitmap( 0, "..\bitmaps\Level5.bmp" ) }

   if ! File( "clientes.dbf" )
      DbCreate( "Clientes.dbf", { { "Nombre",    "C", 40, 0 },;
                                  { "Direccion", "C", 50, 0 },;
                                  { "Telefono",  "C", 12, 0 },;
                                  { "Edad",      "N",  2, 0 },;
                                  { "Productos", "C", 10, 0 },;
                                  { "Nivel",     "N",  2, 0 } } )
   endif
   
   USE Clientes
   if RecCount() == 0
      APPEND BLANK
   endif
   INDEX ON Clientes->Nombre TO CliName
   SET INDEX TO CliName
   GO TOP

   DEFINE DIALOG oDlg FROM 3, 3 TO 26, 79 TITLE "Clients Management"

   @ 0,  1 SAY " &Clients List"  OF oDlg

   @ 1, 1 LISTBOX oLbx FIELDS aHBitmaps[ Max( 1, Clientes->Nivel ) ],;
                              Clientes->Nombre, Clientes->Direccion,;
                              Clientes->Telefono, ;
                              Str( Clientes->Edad, 3 ) ;
          HEADERS    "Lev.", "Name", "Address", "Phone", "Age" ;
          FIELDSIZES 34, 240, 310, 114, 24 ;
          SELECT Nombre FOR "Laureano" TO "Paco" ;
          SIZE 284, 137 OF oDlg


   @ 13,  1 BUTTON "&New"    OF oDlg ACTION EditClient( oLbx, .t. ) ;
                                              SIZE 40, 12
   @ 13,  8 BUTTON "&Modify" OF oDlg ACTION EditClient( oLbx, .f. ) ;
                                              SIZE 40, 12
   @ 13, 15 BUTTON "&Delete" OF oDlg ACTION DelClient( oLbx )  SIZE 40, 12
   @ 13, 22 BUTTON "&Search" OF oDlg ACTION SeekClient( oLbx ) SIZE 40, 12
   @ 13, 29 BUTTON "&Print"  OF oDlg ACTION Listar( oLbx )     SIZE 40, 12
   @ 13, 36 BUTTON "&Exit"   OF oDlg ACTION oDlg:End()         SIZE 40, 12


   if DbSeek( "Laureano" )          // First SELECT condition
      ACTIVATE DIALOG oDlg
   endif

   USE

   AEval( aHBitmaps, { | hBmp | DeleteObject( hBmp ) } )
   
return nil

//----------------------------------------------------------------------------//

static function EditClient( oLbx, lAppend )

   local oDlg
   local lFivePro
   local lDialog
   local lObjects
   local nNivel
   local cName
   local cAddress
   local cPhone
   local nAge
   local lSave := .f.
   local nOldRec := RecNo()

   DEFAULT lAppend := .f.

   if lAppend
      GOTO BOTTOM
      SKIP
   endif

   lFivePro = "F" $ Clientes->Productos
   lDialog  = "D" $ Clientes->Productos
   lObjects = "O" $ Clientes->Productos
   nNivel   = max( 1, Clientes->Nivel )
   cName    = Clientes->Nombre
   cAddress = Clientes->Direccion
   cPhone   = Clientes->Telefono
   nAge     = Clientes->Edad

   DEFINE DIALOG oDlg FROM 8, 2 TO 25, 65 ;
      TITLE If( lAppend, "Nuevo Cliente", "Modifique Cliente" )

   @ 1,  1 SAY "&Nombre:" OF oDlg
   @ 1,  6 GET cName OF oDlg
   @ 2,  1 SAY OemToAnsi( "&Direcci.n:" ) OF oDlg
   @ 2,  6 GET cAddress OF oDlg

   @ 3,  1 TO 7, 8 LABEL "&Productos" OF oDlg
   @ 4,  1 CHECKBOX lFivePro PROMPT "&FivePro" OF oDlg
   @ 5,  1 CHECKBOX lDialog  PROMPT "&Dialog"  OF oDlg
   @ 6,  1 CHECKBOX lObjects PROMPT "&Objects" OF oDlg

   @ 3,  9 TO 7, 17 LABEL "&Nivel" OF oDlg
   @ 4,  9 RADIO nNivel PROMPT "&Inicial", "A&vanzado", "&Experto" OF oDlg

   @ 4, 16 SAY OemToAnsi( "&Tel.fono:" ) OF oDlg
   @ 4, 21 GET cPhone OF oDlg SIZE 60, 11 PICTURE "@R 99-999-9999999"

   @ 6, 16 SAY OemToAnsi( "&Edad:" ) OF oDlg
   @ 6, 21 GET nAge OF oDlg SIZE 20, 11

   @ 9,  9 BUTTON "&Aceptar"  OF oDlg SIZE 50, 12 ACTION ( lSave := .t. , oDlg:End() )
   @ 9, 19 BUTTON "&Cancelar" OF oDlg SIZE 50, 12 ACTION oDlg:End()

   ACTIVATE DIALOG oDlg CENTERED

   if lSave .and. !empty( cName )

      if lAppend
         APPEND BLANK
      endif

      Clientes->Nombre     := cName
      Clientes->Direccion  := cAddress
      Clientes->Productos  := if( lFivePro, "F", "" ) + ;
                              if( lDialog,  "D", "" ) + ;
                              if( lObjects, "O", "" )

      Clientes->Nivel      := nNivel
      Clientes->Telefono   := cPhone
      Clientes->Edad       := nAge

      oLbx:Refresh()          // We want the ListBox to be repainted

   else

      if empty( cName ) .and. lSave
         nMsgBox( "Debe entrar un Nombre para que el registro se valide" )
      endif

      GOTO nOldRec

   endif

return nil

//---------------------------------------------------------------------------//

static function DelClient( oLbx )

   if MsgYesNo( OemToAnsi( "Atenci.n:" ) + CRLF + ;
                OemToAnsi( ". Est. seguro de " + ;
                "querer borrar este registro ?" ) + CRLF + CRLF + ;
                OemToAnsi( Clientes->Nombre ) )
      DELETE
      PACK

      oLbx:Refresh()  // Repintamos el ListBox

   endif

return nil

//----------------------------------------------------------------------------//

static function SeekClient( oLbx )

   local cNombre := Space( 30 )
   local nRecNo  := RecNo()

   SET SOFTSEEK ON

   if MsgGet( "Buscar por", "Nombre del Cliente", @cNombre,;
              "..\bitmaps\lupa.bmp" )

      if ! DbSeek( cNombre )
         nMsgBox( "No encuentro ese Cliente", OemToAnsi( "Atenci.n" ) )
         GO nRecNo
      else
         oLbx:UpStable()           // Corrects same page stabilizing Bug
         oLbx:Refresh()            // Repintamos el ListBox
      endif
   endif

return nil

//----------------------------------------------------------------------------//

function Listar( oLbx )

   local oPrn, fntArial
   local nRow := 1, nRec := Recno()

   GO TOP

   DEFINE FONT fntArial NAME "Arial" SIZE 40, 60

   PRINT oPrn NAME "Clientes"                // Nombre del listado a generar

      PAGE
         while ! EoF()
            oPrn:Say( nRow, 1, Clientes->Nombre, fntArial )

            nRow += fntArial:nHeight

            if nRow > 50 * fntArial:nHeight  // N. de l.neas x Alto caracter
               nRow = 1                      // Tendremos que calcular el
               ENDPAGE                       // n.mero de l.neas que podemos
               PAGE                          // utilizar con un font determinado
            endif

            SKIP
         end
      ENDPAGE

   ENDPRINT

   GOTO nRec

   RELEASE FONT fntArial

return nil

//----------------------------------------------------------------------------//

function OpenDbf()

   local cFile := cGetFile( "*.dbf", "Select a DBF" )

   if ! Empty( cFile )
      USE ( cFile )

      // Quick and easy browses!
      // Fully integrated into a Dialog Box !!!

      Browse( "FiveWin Automatic Browse Power",;
              "Easy Browses without pain...",;
              { || MsgInfo( "This will be executed from first button...", "Info1" ) },;
              { || MsgInfo( "You can atach any action to the buttons...", "Info2" ) },;
              { || MsgInfo( "We also provide full source code of this...", "Info3" ) },;
              { || MsgInfo( "So you can adapt it to your necesities", "Info4" ) } )
      USE
   endif

return nil

//----------------------------------------------------------------------------//