Código: Selecionar todos
// Quick Browse sample - C:\FWH1505\SAMPLES\FWBROW.PRG
#include "FiveWin.ch"
static oWnd
//----------------------------------------------------------------------------//
function Main()
local oBrush, oBar, oBmp
SET _3DLOOK ON // Microsoft 3D Look
SkinButtons()
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() ;
TOOLTIP "Edit"
DEFINE BUTTON FILENAME "..\bitmaps\Ques2.bmp" OF oBar ;
MESSAGE "FiveWin info" ACTION MsgAbout()
SET MESSAGE OF oWnd TO FWVERSION + FWCOPYRIGHT CLOCK DATE
@ 4, 16 BITMAP oBmp FILENAME "..\bitmaps\Tutanka1.bmp" ADJUST SIZE 280, 200 OF oWnd ;
ON CLICK ( oBmp:lStretch := ! oBmp:lStretch, oBmp:Refresh( .t. ) )
ACTIVATE WINDOW oWnd ;
ON RESIZE oBmp:Center()
return nil
//----------------------------------------------------------------------------//
function BuildMenu()
local oMenu
MENU oMenu
MENUITEM "&Information"
MENU
MENUITEM "&About..." + Chr( 9 ) + "Alt+A" ;
ACTION MsgAbout( FWCOPYRIGHT, FWVERSION ) ;
MESSAGE "Some information about this demo" ;
ACCELERATOR ACC_ALT, Asc( "A" ) ;
FILENAME "..\bitmaps\16x16\info.bmp"
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 cVar
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" ) }
local n
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, AllTrim( Clientes->Direccion ),;
Clientes->Telefono,;
Str( Clientes->Edad, 3 ) ;
HEADERS "L", "Name", "Address", "Phone", "Age" ;
FIELDSIZES 16, 222, 213, 58, 24 ;
SIZE 284, 137 OF oDlg
// Lets use different row colors
oLbx:nClrText = { || SelColor( Clientes->Nivel ) }
oLbx:nClrForeFocus = { || SelColor( Clientes->Nivel ) }
oLbx:bRClicked = { | nRow, nCol | ShowPopup( nRow, nCol, oLbx ) }
// Try different line styles !!!
oLbx:nLineStyle = 1
oLbx:bKeyChar := {|nKey| if( nKey == VK_RETURN , EditRecord( oLbx ) , )}
oLbx:aJustify = { .f., .f., .t., .f., .t. }
// TWBrowse():lKinetic = .F. // changed as global setting
// Uncomment this to quickly calculate the desired columns width
// Right click with the mouse over the browse and you will
// see the columns sizes!
// oLbx:bRClicked = { || oLbx:ShowSizes() }
@ 8.7, 1.4 BUTTON "&New" OF oDlg ACTION EditClient( oLbx, .t. ) ;
SIZE 40, 12
@ 8.7, 9.4 BUTTON "&Modify" OF oDlg ACTION EditClient( oLbx, .f. ) ;
SIZE 40, 12
@ 8.7, 17.4 BUTTON "&Delete" OF oDlg ACTION DelClient( oLbx ) SIZE 40, 12
@ 8.7, 25.4 BUTTON "&Search" OF oDlg ACTION SeekClient( oLbx ) SIZE 40, 12
@ 8.7, 33.4 BUTTON "&Print" OF oDlg ;
ACTION oLbx:Report( "clients Report", .t. ) ; // .t. --> wants preview
SIZE 40, 12
@ 8.7, 42 BUTTON "&Exit" OF oDlg ACTION oDlg:End() SIZE 40, 12
ACTIVATE DIALOG oDlg
USE
AEval( aHBitmaps, { | hBmp | DeleteObject( hBmp ) } )
return nil
//----------------------------------------------------------------------------//
function EditRecord( oLbx )
local i
local cVar
local cAlias := oLbx:cAlias
for i := 1 to 4
cVar = ( cAlias )->( FieldGet( i ) )
if ! oLbx:lEditCol( i + 1, @cVar,, { || Validate() } )
exit
endif
( cAlias )->( FieldPut( i , cVar ) )
next
return nil
//----------------------------------------------------------------------------//
function Validate()
local lOk
lOk := MsgYesNo( 'Is it ok ?' )
MsgInfo( lOk )
return ( lOk )
//----------------------------------------------------------------------------//
function ShowPopup( nRow, nCol, oLbx )
local oPopup
MENU oPopup POPUP
MENUITEM "&New" ACTION EditClient( oLbx, .t. )
MENUITEM "&Modify" ACTION EditClient( oLbx, .f. )
MENUITEM "&Delete" ACTION DelClient( oLbx )
MENUITEM "&Search" ACTION SeekClient( oLbx )
MENUITEM "&Print" ACTION oLbx:Report( "clients Report", .t. )
SEPARATOR
MENUITEM "&Browse lines style"
MENU
MENUITEM "None (0)" ACTION oLbx:nLineStyle := 0, oLbx:Refresh()
MENUITEM "Black (1)" ACTION oLbx:nLineStyle := 1, oLbx:Refresh()
MENUITEM "Gray (2)" ACTION oLbx:nLineStyle := 2, oLbx:Refresh()
MENUITEM "3D (3)" ACTION oLbx:nLineStyle := 3, oLbx:Refresh()
MENUITEM "DOTED (4)" ACTION oLbx:nLineStyle := 4, oLbx:Refresh()
MENUITEM "V_BLACK (5)" ACTION oLbx:nLineStyle := 5, oLbx:Refresh()
MENUITEM "V_GRAY (6)" ACTION oLbx:nLineStyle := 6, oLbx:Refresh()
MENUITEM "H_BLACK (7)" ACTION oLbx:nLineStyle := 7, oLbx:Refresh()
MENUITEM "H_GRAY (8)" ACTION oLbx:nLineStyle := 8, oLbx:Refresh()
ENDMENU
SEPARATOR
MENUITEM "&Exit" ACTION oLbx:oWnd:End()
ENDMENU
ACTIVATE POPUP oPopup AT nRow, nCol OF oLbx
return nil
//----------------------------------------------------------------------------//
static function SelColor( nNivel )
local nColor := CLR_BLACK
do case
case nNivel == 1
nColor = CLR_HRED
case nNivel == 2
nColor = CLR_HGREEN
case nNivel == 3
nColor = CLR_HBLUE
endcase
return nColor
//----------------------------------------------------------------------------//
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, "New Customer", "Customer Update" )
@ 1, 1 SAY "&Name:" OF oDlg
@ 1, 6 GET cName OF oDlg
@ 2, 1 SAY "&Address:" OF oDlg
@ 2, 6 GET cAddress OF oDlg
@ 3, 1 GROUP TO 7, 8 LABEL "&Products" OF oDlg
@ 4, 2 CHECKBOX lFivePro PROMPT "&FivePro" OF oDlg
@ 5, 2 CHECKBOX lDialog PROMPT "&Dialog" OF oDlg
@ 6, 2 CHECKBOX lObjects PROMPT "&Objects" OF oDlg
@ 3, 9 GROUP TO 7, 17 LABEL "&Nivel" OF oDlg
@ 4, 9 RADIO nNivel PROMPT "&Novice", "A&vanced", "&Expert" OF oDlg
@ 3.5, 23 SAY "&Phone:" OF oDlg
@ 4, 21 GET cPhone OF oDlg SIZE 60, 11 PICTURE "@R 99-999-9999999"
@ 5, 23 SAY OemToAnsi( "&Age:" ) OF oDlg
@ 6, 21 GET nAge OF oDlg SIZE 20, 11
@ 6, 9 BUTTON "&Acept" OF oDlg SIZE 50, 12 ACTION ( lSave := .t. , oDlg:End() )
@ 6, 19 BUTTON "&Cancel" 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
MsgAlert( "Please write a name" )
endif
GOTO nOldRec
endif
return nil
//---------------------------------------------------------------------------//
static function DelClient( oLbx )
if MsgYesNo( "Are you sure to delete this record ?" )
DELETE
PACK
oLbx:Refresh() // Repaint the ListBox
endif
return nil
//----------------------------------------------------------------------------//
static function SeekClient( oLbx )
local cNombre := Space( 30 )
local nRecNo := RecNo()
SET SOFTSEEK ON
if MsgGet( "Search", "Customer Name", @cNombre,;
"..\bitmaps\lupa.bmp" )
if ! DbSeek( cNombre )
MsgAlert( "I don't find that customer" )
GO nRecNo
else
oLbx:UpStable() // Corrects same page stabilizing Bug
oLbx:Refresh() // Repaint the ListBox
endif
endif
return nil
//----------------------------------------------------------------------------//
function OpenDbf()
local cFile := cGetFile( "Clipper DataBase (*.dbf) | *.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
//---------------------------------------------------------------------------//
procedure AppSys // XBase++ requirement
return
?