FiveDBU for 32/64 bits

User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: FiveDBU for 32/64 bits

Post by Antonio Linares »

Stefan,

Many thanks for your help! :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: FiveDBU for 32/64 bits

Post by Antonio Linares »

Automatic editing for Memo fields:

Image

Code: Select all

#include "FiveWin.ch"
#include "xbrowse.ch"

#ifdef __XHARBOUR__
   #define hb_CurDrive() CurDrive()
#endif   

REQUEST DBFCDX

static oWndMain, oMruDBFs, aSearches := {}

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

function Main()

   local oBar, oBmpTiled
   
   SET DATE FORMAT TO "DD/MM/YYYY"

   SetDlgGradient( { { 1, RGB( 199, 216, 237 ), RGB( 237, 242, 248 ) } } )

   DEFINE BITMAP oBmpTiled RESOURCE "background"

   DEFINE WINDOW oWndMain TITLE "FiveDBU" MDI MENU BuildMenu()

   DEFINE BUTTONBAR oBar OF oWndMain 2010 SIZE 70, 70
   
   DEFINE BUTTON OF oBar PROMPT "New" RESOURCE "new" ACTION New()

   DEFINE BUTTON OF oBar PROMPT "Open" RESOURCE "open" ACTION Open()

   DEFINE BUTTON OF oBar PROMPT "Prev" RESOURCE "prev" ;
      ACTION oWndMain:PrevWindow() GROUP WHEN Len( oWndMain:oWndClient:aWnd ) > 1

   DEFINE BUTTON OF oBar PROMPT "Next" RESOURCE "next" ;
      ACTION oWndMain:NextWindow() WHEN Len( oWndMain:oWndClient:aWnd ) > 1

   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
      ACTION oWndMain:End() GROUP

   DEFINE MSGBAR PROMPT "FiveDBU 32/64 bits, (c) FiveTech Software 2012" ;
      OF oWndMain 2010 KEYBOARD DATE

   ACTIVATE WINDOW oWndMain MAXIMIZED ;
      VALID MsgYesNo( "Want to end ?" ) ;
      ON PAINT DrawTiled( hDC, oWndMain, oBmpTiled )
   
   oBmpTiled:End()      

return nil

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

function BuildMenu()

   local oMenu
   
   MENU oMenu
      MENUITEM "Files"
      MENU
         MENUITEM "New..."
         MENUITEM "Open..." ACTION Open()
         SEPARATOR
         MENUITEM "Recent files"
         MENU
            MRU oMruDBFs ;
               FILENAME ".\FiveDBU.ini" ;    // .INI to manipulate. '\.' for local
               SECTION  "Recent DBF files" ; // The name of the INI section
               ACTION   Open( cMruItem ) ;   // cMruItem is automatically provided
               MESSAGE  "Open this file" ;   // The message for all of them
               SIZE     10
         ENDMENU       

         SEPARATOR
         MENUITEM "Exit" ACTION oWndMain:End()
      ENDMENU
      
      // oMenu:AddEdit()
      oMenu:AddMdi()
      oMenu:AddHelp( "FiveDBU", "(c) FiveTech Software 2012" )
   ENDMENU
   
return oMenu      

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

function Open( cFileName )

   local oWnd, oBar, oBrw, oMsgBar, oPopup, cAlias, n
   
   DEFAULT cFileName := cGetFile( "*.dbf", "Please select a DBF" )
   
   if Empty( cFileName )
      return nil
   endif   
   
   if ! "." $ cFileName
      cFileName += ".dbf"
   endif   
   
   if ! File( cFileName )
      MsgStop( "File not found: " + cFileName )
      return nil
   endif
   
   if File( cFileNoExt( cFileName ) + ".ntx" )
      USE ( cFileName ) VIA "DBFNTX" NEW SHARED ;
         ALIAS ( cGetNewAlias( cFileName( cFileNoExt( cFileName ) ) ) )
   else   
      USE ( cFileName ) VIA "DBFCDX" NEW SHARED ;
         ALIAS ( cGetNewAlias( cFileName( cFileNoExt( cFileName ) ) ) )
      cAlias = Alias()
   endif        
   
   oMruDBFs:Save( cFileName )
   
   MENU oPopup POPUP
      MENUITEM "Natural order" ;
         ACTION ( ( cAlias )->( DbSetOrder( 0 ) ), oBrw:Refresh(), oBrw:SetFocus() )
      SEPARATOR   
      for n = 1 to 15
         if ! Empty( OrdName( n ) )
            if ! Empty( OrdName( 1 ) )
               DbSetOrder( OrdName( 1 ) )
               DbGoTop()
            endif   
            MENUITEM OrdName( n ) ;
               ACTION ( ( cAlias )->( DbSetOrder( oMenuItem:cPrompt ) ),;
                        oBrw:Refresh(), Eval( oBrw:bChange ), oBrw:SetFocus() )
         endif
      next    
   ENDMENU   
   
   DEFINE WINDOW oWnd TITLE "Browse " + cFileName MDICHILD

   DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70
   
   DEFINE BUTTON OF oBar PROMPT "Add" RESOURCE "add" ;
      ACTION ( ( oBrw:cAlias )->( DbAppend() ), oBrw:Refresh(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Edit" RESOURCE "edit" ;
      ACTION ( oBrw:cAlias )->( Edit() )

   DEFINE BUTTON OF oBar PROMPT "Del" RESOURCE "del" ;
      ACTION If( MsgYesNo( "Want to delete this record ?" ),;
                ( ( oBrw:cAlias )->( DbDelete() ), oBrw:Refresh() ),)

   DEFINE BUTTON OF oBar PROMPT "Search" RESOURCE "search" ;
      GROUP ACTION ( cAlias )->( Search( oBrw ) )

   DEFINE BUTTON OF oBar PROMPT "Index" RESOURCE "index" ;
      MENU oPopup ACTION ( cAlias )->( Indexes() )

   DEFINE BUTTON OF oBar PROMPT "Top" RESOURCE "prev" ;
      ACTION ( oBrw:GoTop(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Bottom" RESOURCE "next" ;
      ACTION ( oBrw:GoBottom(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Struct" RESOURCE "struct" ;
      ACTION ( oBrw:cAlias )->( Struct() ) GROUP

   DEFINE BUTTON OF oBar PROMPT "Report" RESOURCE "report" ;
      ACTION oBrw:Report()

   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ACTION oWnd:End() GROUP

   @ 0, 0 XBROWSE oBrw OF oWnd LINES ;
      ON CHANGE ( oMsgBar:cMsgDef := "Alias: " + Alias() + ;
                                     " RecNo: " + AllTrim( Str( RecNo() ) ) + "/" + ;
                                     AllTrim( Str( RecCount() ) ) + ;
                                     "  Ordered by: " + OrdName(), oMsgBar:Refresh() )

   oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }                      
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   
   oBrw:CreateFromCode()
   oBrw:SetFocus()
   oBrw:bLDblClick = { || ( oBrw:cAlias )->( Edit() ) }                      
   
   oWnd:oClient = oBrw

   DEFINE MSGBAR oMsgBar PROMPT "Alias: " + Alias() + " RecNo: " + ;
      AllTrim( Str( RecNo() ) ) + "/" + ;
      AllTrim( Str( RecCount() ) ) + ;
      "  Ordered by: " + OrdName() OF oWnd 2010 
   
   ACTIVATE WINDOW oWnd ;
      VALID ( ( cAlias )->( DbCloseArea() ), oBrw:cAlias := "", .T. )
   
return nil   

//----------------------------------------------------------------------------//
   
function Edit()

   local oWnd, aRecord := ( Alias() )->( LoadRecord() ), oBar, oBrw, oMsgBar
   local cAlias := Alias(), oBtnSave, nRecNo := ( Alias() )->( RecNo() )
   
   DEFINE WINDOW oWnd TITLE "Edit " + Alias() MDICHILD

   oWndMain:oBar:AEvalWhen()

   DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70
   
   DEFINE BUTTON oBtnSave OF oBar PROMPT "Save" RESOURCE "save" ;
      ACTION ( ( cAlias )->( SaveRecord( aRecord, nRecNo ) ), oBtnSave:Disable() )

   oBtnSave:Disable()

   DEFINE BUTTON OF oBar PROMPT "Prev" RESOURCE "prev" ;
      ACTION ( ( cAlias )->( DbSkip( -1 ) ),;
               oBrw:SetArray( aRecord := ( cAlias )->( LoadRecord() ) ),;
               oBrw:SetFocus(), Eval( oBrw:bChange ) ) GROUP

   DEFINE BUTTON OF oBar PROMPT "Next" RESOURCE "next" ;
      ACTION ( ( cAlias )->( DbSkip( 1 ) ),;
               If( ( cAlias )->( Eof() ), ( cAlias )->( DbSkip( -1 ) ),),;
               oBrw:SetArray( aRecord := ( cAlias )->( LoadRecord() ) ),;
               oBrw:SetFocus(), Eval( oBrw:bChange ) ) GROUP

   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
      ACTION oWnd:End() GROUP

   @ 0, 0 XBROWSE oBrw OF oWnd ARRAY aRecord AUTOCOLS LINES ;
      HEADERS "FieldName", "Value" COLSIZES 150, 400 FASTEDIT ;
      ON CHANGE ( ( cAlias )->( SetEditType( oBrw ) ),;
                  oMsgBar:cMsgDef := " RecNo: " + AllTrim( Str( ( cAlias )->( RecNo() ) ) ) + ;
                                 "/" + AllTrim( Str( ( cAlias )->( RecCount() ) ) ),;
                  oMsgBar:Refresh() )                 

   oBrw:nEditTypes = EDIT_GET
   oBrw:aCols[ 1 ]:nEditType = 0 // Don't allow to edit first column
   oBrw:aCols[ 2 ]:bOnChange = { || oBtnSave:Enable() }
   oBrw:aCols[ 2 ]:lWillShowABtn = .T.
   oBrw:nMarqueeStyle = MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }                      
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   oBrw:CreateFromCode()
   oBrw:SetFocus()
   
   oWnd:oClient = oBrw

   DEFINE MSGBAR oMsgBar ;
      PROMPT " RecNo: " + AllTrim( Str( ( cAlias )->( RecNo() ) ) ) + "/" + ;
      AllTrim( Str( ( cAlias )->( RecCount() ) ) ) OF oWnd 2010
   
   ACTIVATE WINDOW oWnd
   
return nil      

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

function SetEditType( oBrw )

   local cType := FieldType( oBrw:nArrayAt )
   
   do case
      case cType == "M"
           oBrw:aCols[ 2 ]:nEditType = EDIT_BUTTON
           oBrw:aCols[ 2 ]:bEditBlock = { || MemoEdit( @oBrw:aRow[ 2 ], FieldName( oBrw:nArrayAt ) ),;
                                             oBrw:aRow[ 2 ] }
   
      case cType == "D"
           oBrw:aCols[ 2 ]:nEditType = EDIT_BUTTON
           oBrw:aCols[ 2 ]:bEditBlock = { || If( ! Empty( oBrw:aRow[ 2 ] ) .and. ;
                                                 ! AllTrim( oBrw:aRow[ 2 ] ) == "/  /",;
                                             DToC( MsgDate( CtoD( oBrw:aRow[ 2 ] ) ) ),;
                                             DToC( MsgDate( Date() ) ) ) }
   
      case cType == "L"
           oBrw:aCols[ 2 ]:nEditType = EDIT_LISTBOX
           oBrw:aCols[ 2 ]:aEditListTxt   = { ".T.", ".F." }
           
      otherwise
           oBrw:aCols[ 2 ]:nEditType = EDIT_GET
   endcase
   
return nil              

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

function IndexBuilder()

   local oDlg, cKey := Space( 80 )
   
   DEFINE DIALOG oDlg TITLE "Index builder" SIZE 600, 500 

   oDlg:lDesign = .T.

   @ 0.5,  2 SAY "Index on" OF oDlg SIZE 40, 8

   @ 1.4, 1 GET cKey OF oDlg SIZE 140, 11 ACTION ExpBuilder()
   
   @ 0.5, 15 SAY "Tag" OF oDlg SIZE 40, 8
   
   ACTIVATE DIALOG oDlg CENTERED

return nil

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

function Indexes()

   local oWnd, oBar, oBrw, oMsgBar
   local cAlias := Alias(), aIndexes := {}, n 
   
   for n = 1 to 15
      if ! Empty( OrdName( n ) )
         AAdd( aIndexes, { n,;
                           OrdName( n ),;
                           OrdKey( n ),;
                           OrdFor( n ),;
                           OrdBagName( n ),;
                           OrdBagExt( n ) } )
      endif   
   next    
   
   DEFINE WINDOW oWnd TITLE "Indexes of " + Alias() MDICHILD

   oWndMain:oBar:AEvalWhen()

   DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70

   DEFINE BUTTON OF oBar PROMPT "Add" RESOURCE "add" ;
      ACTION ( MsgInfo( "Add Tag" ), oBrw:Refresh(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Edit" RESOURCE "edit" ;
      ACTION ( MsgInfo( "Edit" ) )

   DEFINE BUTTON OF oBar PROMPT "Del" RESOURCE "del" ;
      ACTION If( MsgYesNo( "Want to delete this tag ?" ),;
                ( ( cAlias )->( OrdBagClear( oBrw:nArrayAt ) ), oBrw:Refresh() ),)
   
   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
      ACTION oWnd:End() GROUP

   @ 0, 0 XBROWSE oBrw OF oWnd ARRAY aIndexes AUTOCOLS LINES ;
      HEADERS "Order", "TagName", "Expression", "For", "BagName", "BagExt" ;
      COLSIZES 50, 150, 400, 400, 150, 150

   oBrw:nMarqueeStyle = MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }                      
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   oBrw:CreateFromCode()
   oBrw:SetFocus()
   
   oWnd:oClient = oBrw

   DEFINE MSGBAR oMsgBar 2010
   
   ACTIVATE WINDOW oWnd 

return nil

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

function ExpBuilder()

   local oDlg
   
   DEFINE DIALOG oDlg TITLE "Expression builder"
   
   ACTIVATE DIALOG oDlg CENTERED

return nil

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

function LoadRecord()

   local aRecord := {}, n
   
   for n = 1 to FCount()
      AAdd( aRecord, { FieldName( n ), FieldGet( n ) } )
   next
   
return aRecord      
   
//----------------------------------------------------------------------------// 

function Search( oBrw )

   local oDlg, oCbx, cSearch := Space( 50 )
   local nRecNo := RecNo(), lInc := .T.
   
   DEFINE DIALOG oDlg TITLE "Search: " + Alias() SIZE 400, 200
   
   @ 0.5, 1.5 SAY "Ordered by: " + OrdName() OF oDlg
   
   @ 1.2, 1.5 SAY "Key: " + OrdKey() OF oDlg
   
   @ 2.4, 1.2 COMBOBOX oCbx VAR cSearch ITEMS aSearches OF oDlg SIZE 180, 150 ;
     STYLE CBS_DROPDOWN
   
   oCbx:oGet:bChange = { || DbSeek( AllTrim( oCbx:GetText() ), lInc ), oBrw:Refresh() } 
   
   @ 3.7, 1.5 CHECKBOX lInc PROMPT "&Incremental" OF oDlg SIZE 80, 10
   
   @ 4, 7 BUTTON "&Ok" OF oDlg SIZE 45, 13 ;
      ACTION ( If( ! DbSeek( AllTrim( cSearch ), lInc ), DbGoTo( nRecNo ),),;
               AAdd( aSearches, AllTrim( cSearch ) ), oDlg:End() )

   @ 4, 18 BUTTON "&Cancel" OF oDlg SIZE 45, 13 ACTION oDlg:End()
   
   ACTIVATE DIALOG oDlg CENTERED
   
return nil   

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

function SaveRecord( aRecord, nRecNo )

   local n

   ( Alias() )->( DbGoTo( nRecNo ) )
   
   for n = 1 to Len( aRecord )
      ( Alias() )->( FieldPut( n, aRecord[ n ][ 2 ] ) )
   next

   MsgInfo( "Record updated" )
   
return nil      

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

function Struct()

   local oDlg, oBrw, aFields := DbStruct()
   
   DEFINE DIALOG oDlg TITLE Alias() + " fields" SIZE 400, 400

   @ 0, 0 XBROWSE oBrw ARRAY aFields AUTOCOLS LINES ;
      HEADERS "Name", "Type", "Len", "Dec" ;
      COLSIZES 150, 50, 80, 80

   oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }                      
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   
   oBrw:CreateFromCode()
      
   oDlg:oClient = oBrw
   
   ACTIVATE DIALOG oDlg CENTERED ;
      ON INIT ( BuildStructBar( oDlg, oBrw ), oDlg:Resize(), oBrw:SetFocus() )
   
return nil   

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

function BuildStructBar( oDlg, oBrw )

   local oBar

   DEFINE BUTTONBAR oBar OF oDlg 2010 SIZE 70, 70
   
   DEFINE BUTTON OF oBar PROMPT "Code" RESOURCE "code" ;
      ACTION ( TxtStruct(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
      ACTION oDlg:End() GROUP

return nil

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

function TxtStruct()

   local cCode := "local aFields := { ", n
   
   for n = 1 to FCount()
      if n > 1
         cCode += Space( 27 )
      endif   
      cCode += '{ "' + FieldName( n ) + '", "' + ;
               FieldType( n ) + '", ' + ;
               AllTrim( Str( FieldLen( n ) ) ) + ", " + ;
               AllTrim( Str( FieldDec( n ) ) ) + " },;" + CRLF
   next
   
   cCode = SubStr( cCode, 1, Len( cCode ) - 4 ) + " }"
   
   MemoEdit( cCode, "Code" )

return nil

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

function New()

   local oDlg, oGet, oBrw 
   local cFieldName := Space( 10 ), cType, nLen := 10, nDec := 0
   local aFields := { Array( 4 ) }, cDbfName := Space( 8 ), aTemp
   
   DEFINE DIALOG oDlg TITLE "DBF builder" SIZE 415, 400

   @ 0.5,  2 SAY "Field Name" OF oDlg SIZE 40, 8
   @ 0.5, 10 SAY "Type" OF oDlg SIZE 40, 8
   @ 0.5, 17 SAY "Len" OF oDlg SIZE 40, 8
   @ 0.5, 22 SAY "Dec" OF oDlg SIZE 20, 8 
   
   @ 1.4, 1 GET oGet VAR cFieldName PICTURE "!!!!!!!!!!" OF oDlg SIZE 41, 11
   
   @ 1.3, 6.5 COMBOBOX cType ITEMS { "Character", "Number", "Date", "Logical", "Memo" } ;
      OF oDlg ON CHANGE ( If( cType == "Character", ( nLen := 10, nDec := 0 ),),;
                          If( cType == "Number", nDec := 0,),;
                          If( cType == "Date", ( nLen := 8, nDec := 0 ),),;
                          If( cType == "Logical", ( nLen := 1, nDec := 0 ),),;
                          If( cType == "Memo", ( nLen := 10, nDec := 0 ),),;
                             oDlg:Update() )
                             
   @ 1.4, 11.9 GET nLen PICTURE "999" OF oDlg SIZE 25, 11 UPDATE

   @ 1.4, 15.4 GET nDec PICTURE "999" OF oDlg SIZE 25, 11 WHEN cType = "Number" UPDATE
   
   @ 0.9, 26 BUTTON "&Add" OF oDlg SIZE 45, 13 ;
      ACTION AddField( @aFields, @cFieldName, @cType, @nLen, @nDec, oGet, oBrw )

   @ 2.2, 2 SAY "Fields" OF oDlg SIZE 40, 8
   
   @ 3.2, 1 XBROWSE oBrw ARRAY aFields AUTOCOLS ;
      HEADERS "Name", "Type", "Len", "Dec" ;
      COLSIZES 90, 55, 40, 40 ;
      SIZE 140, 130 OF oDlg

   oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }    
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   oBrw:CreateFromCode()

   @ 2.4, 26 BUTTON "&Edit" OF oDlg SIZE 45, 13

   @ 3.4, 26 BUTTON "&Delete" OF oDlg SIZE 45, 13

   @ 4.4, 26 BUTTON "Move &Up" OF oDlg SIZE 45, 13 ;
      ACTION If( oBrw:nArrayAt > 1,;
                 ( aTemp := aFields[ oBrw:nArrayAt ],;
                   aFields[ oBrw:nArrayAt ] := aFields[ oBrw:nArrayAt - 1 ],;
                   aFields[ oBrw:nArrayAt - 1 ] := aTemp,;
                   oBrw:GoUp() ),) 

   @ 5.4, 26 BUTTON "Move D&own" OF oDlg SIZE 45, 13 ;
      ACTION If( oBrw:nArrayAt < Len( aFields ),;
                 ( aTemp := aFields[ oBrw:nArrayAt ],;
                   aFields[ oBrw:nArrayAt ] := aFields[ oBrw:nArrayAt + 1 ],;
                   aFields[ oBrw:nArrayAt + 1 ] := aTemp,;
                   oBrw:GoDown() ),) 

   @ 12.1, 2 SAY "DBF Name:" OF oDlg SIZE 30, 8

   @ 14, 6 GET cDbfName PICTURE "!!!!!!!!!!!!" OF oDlg SIZE 100, 11

   @ 10, 26 BUTTON "&Create" OF oDlg SIZE 45, 13 ;
      ACTION ( If( ! Empty( cDbfName ) .and. Len( aFields ) > 0,;
          DbCreate( AllTrim( cDbfName ), aFields ),), oDlg:End(),;
          Open( hb_CurDrive() + ":\" + CurDir() + "\" + AllTrim( cDbfName ) ) )

   ACTIVATE DIALOG oDlg CENTERED

return nil

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

function AddField( aFields, cFieldName, cType, nLen, nDec, oGet, oBrw )

   if Empty( cFieldName )
      oGet:SetPos( 0 )
      return nil
   endif   

   if Len( aFields ) == 1 .and. Empty( aFields[ 1 ][ 1 ] )
      aFields = { { cFieldName, Upper( Left( cType, 1 ) ), nLen, nDec } }
   else   
      AAdd( aFields, { cFieldName, Upper( Left( cType, 1 ) ), nLen, nDec } )
   endif
      
   oBrw:SetArray( aFields )
   oGet:VarPut( cFieldName := Space( 10 ) )
   oGet:SetPos( 0 )
   oGet:SetFocus()
   oBrw:GoBottom()
               
return nil

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

#pragma BEGINDUMP

#include <hbapi.h>
#include <hbapirdd.h>

HB_FUNC( ORDCONDGET )
{
   AREAP pArea = ( AREAP ) hb_rddGetCurrentWorkAreaPointer();
   
   if( pArea )
   {
      LPDBORDERCONDINFO lpdbOrdCondInfo = pArea->lpdbOrdCondInfo;
      
      if( lpdbOrdCondInfo && lpdbOrdCondInfo->abWhile )
         hb_retc( lpdbOrdCondInfo->abWhile );
      else
         hb_retc( "" );   
   }
   else
      hb_retc( "" );     
}

#pragma ENDDUMP

//----------------------------------------------------------------------------//  
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: FiveDBU for 32/64 bits

Post by Antonio Linares »

Added automatic records lock when saving:

Code: Select all

#include "FiveWin.ch"
#include "xbrowse.ch"

#ifdef __XHARBOUR__
   #define hb_CurDrive() CurDrive()
#endif   

REQUEST DBFCDX

static oWndMain, oMruDBFs, aSearches := {}

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

function Main()

   local oBar, oBmpTiled
   
   SET DATE FORMAT TO "DD/MM/YYYY"

   SetDlgGradient( { { 1, RGB( 199, 216, 237 ), RGB( 237, 242, 248 ) } } )

   DEFINE BITMAP oBmpTiled RESOURCE "background"

   DEFINE WINDOW oWndMain TITLE "FiveDBU" MDI MENU BuildMenu()

   DEFINE BUTTONBAR oBar OF oWndMain 2010 SIZE 70, 70
   
   DEFINE BUTTON OF oBar PROMPT "New" RESOURCE "new" ACTION New()

   DEFINE BUTTON OF oBar PROMPT "Open" RESOURCE "open" ACTION Open()

   DEFINE BUTTON OF oBar PROMPT "Prev" RESOURCE "prev" ;
      ACTION oWndMain:PrevWindow() GROUP WHEN Len( oWndMain:oWndClient:aWnd ) > 1

   DEFINE BUTTON OF oBar PROMPT "Next" RESOURCE "next" ;
      ACTION oWndMain:NextWindow() WHEN Len( oWndMain:oWndClient:aWnd ) > 1

   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
      ACTION oWndMain:End() GROUP

   DEFINE MSGBAR PROMPT "FiveDBU 32/64 bits, (c) FiveTech Software 2012" ;
      OF oWndMain 2010 KEYBOARD DATE

   ACTIVATE WINDOW oWndMain MAXIMIZED ;
      VALID MsgYesNo( "Want to end ?" ) ;
      ON PAINT DrawTiled( hDC, oWndMain, oBmpTiled )
   
   oBmpTiled:End()      

return nil

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

function BuildMenu()

   local oMenu
   
   MENU oMenu
      MENUITEM "Files"
      MENU
         MENUITEM "New..."
         MENUITEM "Open..." ACTION Open()
         SEPARATOR
         MENUITEM "Recent files"
         MENU
            MRU oMruDBFs ;
               FILENAME ".\FiveDBU.ini" ;    // .INI to manipulate. '\.' for local
               SECTION  "Recent DBF files" ; // The name of the INI section
               ACTION   Open( cMruItem ) ;   // cMruItem is automatically provided
               MESSAGE  "Open this file" ;   // The message for all of them
               SIZE     10
         ENDMENU       

         SEPARATOR
         MENUITEM "Exit" ACTION oWndMain:End()
      ENDMENU
      
      // oMenu:AddEdit()
      oMenu:AddMdi()
      oMenu:AddHelp( "FiveDBU", "(c) FiveTech Software 2012" )
   ENDMENU
   
return oMenu      

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

function Open( cFileName )

   local oWnd, oBar, oBrw, oMsgBar, oPopup, cAlias, n
   
   DEFAULT cFileName := cGetFile( "*.dbf", "Please select a DBF" )
   
   if Empty( cFileName )
      return nil
   endif   
   
   if ! "." $ cFileName
      cFileName += ".dbf"
   endif   
   
   if ! File( cFileName )
      MsgStop( "File not found: " + cFileName )
      return nil
   endif
   
   if File( cFileNoExt( cFileName ) + ".ntx" )
      USE ( cFileName ) VIA "DBFNTX" NEW SHARED ;
         ALIAS ( cGetNewAlias( cFileName( cFileNoExt( cFileName ) ) ) )
   else   
      USE ( cFileName ) VIA "DBFCDX" NEW SHARED ;
         ALIAS ( cGetNewAlias( cFileName( cFileNoExt( cFileName ) ) ) )
      cAlias = Alias()
   endif        
   
   oMruDBFs:Save( cFileName )
   
   MENU oPopup POPUP
      MENUITEM "Natural order" ;
         ACTION ( ( cAlias )->( DbSetOrder( 0 ) ), oBrw:Refresh(), oBrw:SetFocus() )
      SEPARATOR   
      for n = 1 to 15
         if ! Empty( OrdName( n ) )
            if ! Empty( OrdName( 1 ) )
               DbSetOrder( OrdName( 1 ) )
               DbGoTop()
            endif   
            MENUITEM OrdName( n ) ;
               ACTION ( ( cAlias )->( DbSetOrder( oMenuItem:cPrompt ) ),;
                        oBrw:Refresh(), Eval( oBrw:bChange ), oBrw:SetFocus() )
         endif
      next    
   ENDMENU   
   
   DEFINE WINDOW oWnd TITLE "Browse " + cFileName MDICHILD

   DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70
   
   DEFINE BUTTON OF oBar PROMPT "Add" RESOURCE "add" ;
      ACTION ( ( oBrw:cAlias )->( DbAppend() ), oBrw:Refresh(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Edit" RESOURCE "edit" ;
      ACTION ( oBrw:cAlias )->( Edit() )

   DEFINE BUTTON OF oBar PROMPT "Del" RESOURCE "del" ;
      ACTION If( MsgYesNo( "Want to delete this record ?" ),;
                ( ( oBrw:cAlias )->( DbDelete() ), oBrw:Refresh() ),)

   DEFINE BUTTON OF oBar PROMPT "Search" RESOURCE "search" ;
      GROUP ACTION ( cAlias )->( Search( oBrw ) )

   DEFINE BUTTON OF oBar PROMPT "Index" RESOURCE "index" ;
      MENU oPopup ACTION ( cAlias )->( Indexes() )

   DEFINE BUTTON OF oBar PROMPT "Top" RESOURCE "prev" ;
      ACTION ( oBrw:GoTop(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Bottom" RESOURCE "next" ;
      ACTION ( oBrw:GoBottom(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Struct" RESOURCE "struct" ;
      ACTION ( oBrw:cAlias )->( Struct() ) GROUP

   DEFINE BUTTON OF oBar PROMPT "Report" RESOURCE "report" ;
      ACTION oBrw:Report()

   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ACTION oWnd:End() GROUP

   @ 0, 0 XBROWSE oBrw OF oWnd LINES ;
      ON CHANGE ( oMsgBar:cMsgDef := "Alias: " + Alias() + ;
                                     " RecNo: " + AllTrim( Str( RecNo() ) ) + "/" + ;
                                     AllTrim( Str( RecCount() ) ) + ;
                                     "  Ordered by: " + OrdName(), oMsgBar:Refresh() )

   oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }                      
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   
   oBrw:CreateFromCode()
   oBrw:SetFocus()
   oBrw:bLDblClick = { || ( oBrw:cAlias )->( Edit() ) }                      
   
   oWnd:oClient = oBrw

   DEFINE MSGBAR oMsgBar PROMPT "Alias: " + Alias() + " RecNo: " + ;
      AllTrim( Str( RecNo() ) ) + "/" + ;
      AllTrim( Str( RecCount() ) ) + ;
      "  Ordered by: " + OrdName() OF oWnd 2010 
   
   ACTIVATE WINDOW oWnd ;
      VALID ( ( cAlias )->( DbCloseArea() ), oBrw:cAlias := "", .T. )
   
return nil   

//----------------------------------------------------------------------------//
   
function Edit()

   local oWnd, aRecord := ( Alias() )->( LoadRecord() ), oBar, oBrw, oMsgBar
   local cAlias := Alias(), oBtnSave, nRecNo := ( Alias() )->( RecNo() )
   
   DEFINE WINDOW oWnd TITLE "Edit " + Alias() MDICHILD

   oWndMain:oBar:AEvalWhen()

   DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70
   
   DEFINE BUTTON oBtnSave OF oBar PROMPT "Save" RESOURCE "save" ;
      ACTION ( ( cAlias )->( SaveRecord( aRecord, nRecNo ) ), oBtnSave:Disable() )

   oBtnSave:Disable()

   DEFINE BUTTON OF oBar PROMPT "Prev" RESOURCE "prev" ;
      ACTION ( ( cAlias )->( DbSkip( -1 ) ),;
               oBrw:SetArray( aRecord := ( cAlias )->( LoadRecord() ) ),;
               oBrw:SetFocus(), Eval( oBrw:bChange ) ) GROUP

   DEFINE BUTTON OF oBar PROMPT "Next" RESOURCE "next" ;
      ACTION ( ( cAlias )->( DbSkip( 1 ) ),;
               If( ( cAlias )->( Eof() ), ( cAlias )->( DbSkip( -1 ) ),),;
               oBrw:SetArray( aRecord := ( cAlias )->( LoadRecord() ) ),;
               oBrw:SetFocus(), Eval( oBrw:bChange ) ) GROUP

   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
      ACTION oWnd:End() GROUP

   @ 0, 0 XBROWSE oBrw OF oWnd ARRAY aRecord AUTOCOLS LINES ;
      HEADERS "FieldName", "Value" COLSIZES 150, 400 FASTEDIT ;
      ON CHANGE ( ( cAlias )->( SetEditType( oBrw, oBtnSave ) ),;
                  oMsgBar:cMsgDef := " RecNo: " + AllTrim( Str( ( cAlias )->( RecNo() ) ) ) + ;
                                 "/" + AllTrim( Str( ( cAlias )->( RecCount() ) ) ),;
                  oMsgBar:Refresh() )                 

   oBrw:nEditTypes = EDIT_GET
   oBrw:aCols[ 1 ]:nEditType = 0 // Don't allow to edit first column
   oBrw:aCols[ 2 ]:bOnChange = { || oBtnSave:Enable() }
   oBrw:aCols[ 2 ]:lWillShowABtn = .T.
   oBrw:nMarqueeStyle = MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }                      
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   oBrw:CreateFromCode()
   oBrw:SetFocus()
   
   oWnd:oClient = oBrw

   DEFINE MSGBAR oMsgBar ;
      PROMPT " RecNo: " + AllTrim( Str( ( cAlias )->( RecNo() ) ) ) + "/" + ;
      AllTrim( Str( ( cAlias )->( RecCount() ) ) ) OF oWnd 2010
   
   ACTIVATE WINDOW oWnd
   
return nil      

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

function SetEditType( oBrw, oBtnSave )

   local cType := FieldType( oBrw:nArrayAt )
   
   do case
      case cType == "M"
           oBrw:aCols[ 2 ]:nEditType = EDIT_BUTTON
           oBrw:aCols[ 2 ]:bEditBlock = { | c | c := oBrw:aRow[ 2 ],;
                                               MemoEdit( @oBrw:aRow[ 2 ], FieldName( oBrw:nArrayAt ) ),;
                                               If( ! c == oBrw:aRow[ 2 ], oBtnSave:Enable(),),;
                                               oBrw:aRow[ 2 ] }
   
      case cType == "D"
           oBrw:aCols[ 2 ]:nEditType = EDIT_BUTTON
           oBrw:aCols[ 2 ]:bEditBlock = { || If( ! Empty( oBrw:aRow[ 2 ] ) .and. ;
                                                 ! AllTrim( oBrw:aRow[ 2 ] ) == "/  /",;
                                             DToC( MsgDate( CtoD( oBrw:aRow[ 2 ] ) ) ),;
                                             DToC( MsgDate( Date() ) ) ) }
   
      case cType == "L"
           oBrw:aCols[ 2 ]:nEditType = EDIT_LISTBOX
           oBrw:aCols[ 2 ]:aEditListTxt   = { ".T.", ".F." }
           
      otherwise
           oBrw:aCols[ 2 ]:nEditType = EDIT_GET
   endcase
   
return nil              

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

function IndexBuilder()

   local oDlg, cKey := Space( 80 )
   
   DEFINE DIALOG oDlg TITLE "Index builder" SIZE 600, 500 

   oDlg:lDesign = .T.

   @ 0.5,  2 SAY "Index on" OF oDlg SIZE 40, 8

   @ 1.4, 1 GET cKey OF oDlg SIZE 140, 11 ACTION ExpBuilder()
   
   @ 0.5, 15 SAY "Tag" OF oDlg SIZE 40, 8
   
   ACTIVATE DIALOG oDlg CENTERED

return nil

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

function Indexes()

   local oWnd, oBar, oBrw, oMsgBar
   local cAlias := Alias(), aIndexes := {}, n 
   
   for n = 1 to 15
      if ! Empty( OrdName( n ) )
         AAdd( aIndexes, { n,;
                           OrdName( n ),;
                           OrdKey( n ),;
                           OrdFor( n ),;
                           OrdBagName( n ),;
                           OrdBagExt( n ) } )
      endif   
   next    
   
   DEFINE WINDOW oWnd TITLE "Indexes of " + Alias() MDICHILD

   oWndMain:oBar:AEvalWhen()

   DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70

   DEFINE BUTTON OF oBar PROMPT "Add" RESOURCE "add" ;
      ACTION ( MsgInfo( "Add Tag" ), oBrw:Refresh(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Edit" RESOURCE "edit" ;
      ACTION ( MsgInfo( "Edit" ) )

   DEFINE BUTTON OF oBar PROMPT "Del" RESOURCE "del" ;
      ACTION If( MsgYesNo( "Want to delete this tag ?" ),;
                ( ( cAlias )->( OrdBagClear( oBrw:nArrayAt ) ), oBrw:Refresh() ),)
   
   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
      ACTION oWnd:End() GROUP

   @ 0, 0 XBROWSE oBrw OF oWnd ARRAY aIndexes AUTOCOLS LINES ;
      HEADERS "Order", "TagName", "Expression", "For", "BagName", "BagExt" ;
      COLSIZES 50, 150, 400, 400, 150, 150

   oBrw:nMarqueeStyle = MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }                      
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   oBrw:CreateFromCode()
   oBrw:SetFocus()
   
   oWnd:oClient = oBrw

   DEFINE MSGBAR oMsgBar 2010
   
   ACTIVATE WINDOW oWnd 

return nil

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

function ExpBuilder()

   local oDlg
   
   DEFINE DIALOG oDlg TITLE "Expression builder"
   
   ACTIVATE DIALOG oDlg CENTERED

return nil

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

function LoadRecord()

   local aRecord := {}, n
   
   for n = 1 to FCount()
      AAdd( aRecord, { FieldName( n ), FieldGet( n ) } )
   next
   
return aRecord      
   
//----------------------------------------------------------------------------// 

function Search( oBrw )

   local oDlg, oCbx, cSearch := Space( 50 )
   local nRecNo := RecNo(), lInc := .T.
   
   DEFINE DIALOG oDlg TITLE "Search: " + Alias() SIZE 400, 200
   
   @ 0.5, 1.5 SAY "Ordered by: " + OrdName() OF oDlg
   
   @ 1.2, 1.5 SAY "Key: " + OrdKey() OF oDlg
   
   @ 2.4, 1.2 COMBOBOX oCbx VAR cSearch ITEMS aSearches OF oDlg SIZE 180, 150 ;
     STYLE CBS_DROPDOWN
   
   oCbx:oGet:bChange = { || DbSeek( AllTrim( oCbx:GetText() ), lInc ), oBrw:Refresh() } 
   
   @ 3.7, 1.5 CHECKBOX lInc PROMPT "&Incremental" OF oDlg SIZE 80, 10
   
   @ 4, 7 BUTTON "&Ok" OF oDlg SIZE 45, 13 ;
      ACTION ( If( ! DbSeek( AllTrim( cSearch ), lInc ), DbGoTo( nRecNo ),),;
               AAdd( aSearches, AllTrim( cSearch ) ), oDlg:End() )

   @ 4, 18 BUTTON "&Cancel" OF oDlg SIZE 45, 13 ACTION oDlg:End()
   
   ACTIVATE DIALOG oDlg CENTERED
   
return nil   

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

function SaveRecord( aRecord, nRecNo )

   local n

   ( Alias() )->( DbGoTo( nRecNo ) )
   
   if ( Alias() )->( DbRLock( nRecNo ) )
      for n = 1 to Len( aRecord )
         ( Alias() )->( FieldPut( n, aRecord[ n ][ 2 ] ) )
      next
      ( Alias() )->( DbUnLock() )
      MsgInfo( "Record updated" )
   else
      MsgAlert( "Record in use, please try it again" )
   endif         

return nil      

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

function Struct()

   local oDlg, oBrw, aFields := DbStruct()
   
   DEFINE DIALOG oDlg TITLE Alias() + " fields" SIZE 400, 400

   @ 0, 0 XBROWSE oBrw ARRAY aFields AUTOCOLS LINES ;
      HEADERS "Name", "Type", "Len", "Dec" ;
      COLSIZES 150, 50, 80, 80

   oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }                      
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   
   oBrw:CreateFromCode()
      
   oDlg:oClient = oBrw
   
   ACTIVATE DIALOG oDlg CENTERED ;
      ON INIT ( BuildStructBar( oDlg, oBrw ), oDlg:Resize(), oBrw:SetFocus() )
   
return nil   

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

function BuildStructBar( oDlg, oBrw )

   local oBar

   DEFINE BUTTONBAR oBar OF oDlg 2010 SIZE 70, 70
   
   DEFINE BUTTON OF oBar PROMPT "Code" RESOURCE "code" ;
      ACTION ( TxtStruct(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
      ACTION oDlg:End() GROUP

return nil

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

function TxtStruct()

   local cCode := "local aFields := { ", n
   
   for n = 1 to FCount()
      if n > 1
         cCode += Space( 27 )
      endif   
      cCode += '{ "' + FieldName( n ) + '", "' + ;
               FieldType( n ) + '", ' + ;
               AllTrim( Str( FieldLen( n ) ) ) + ", " + ;
               AllTrim( Str( FieldDec( n ) ) ) + " },;" + CRLF
   next
   
   cCode = SubStr( cCode, 1, Len( cCode ) - 4 ) + " }"
   
   MemoEdit( cCode, "Code" )

return nil

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

function New()

   local oDlg, oGet, oBrw 
   local cFieldName := Space( 10 ), cType, nLen := 10, nDec := 0
   local aFields := { Array( 4 ) }, cDbfName := Space( 8 ), aTemp
   
   DEFINE DIALOG oDlg TITLE "DBF builder" SIZE 415, 400

   @ 0.5,  2 SAY "Field Name" OF oDlg SIZE 40, 8
   @ 0.5, 10 SAY "Type" OF oDlg SIZE 40, 8
   @ 0.5, 17 SAY "Len" OF oDlg SIZE 40, 8
   @ 0.5, 22 SAY "Dec" OF oDlg SIZE 20, 8 
   
   @ 1.4, 1 GET oGet VAR cFieldName PICTURE "!!!!!!!!!!" OF oDlg SIZE 41, 11
   
   @ 1.3, 6.5 COMBOBOX cType ITEMS { "Character", "Number", "Date", "Logical", "Memo" } ;
      OF oDlg ON CHANGE ( If( cType == "Character", ( nLen := 10, nDec := 0 ),),;
                          If( cType == "Number", nDec := 0,),;
                          If( cType == "Date", ( nLen := 8, nDec := 0 ),),;
                          If( cType == "Logical", ( nLen := 1, nDec := 0 ),),;
                          If( cType == "Memo", ( nLen := 10, nDec := 0 ),),;
                             oDlg:Update() )
                             
   @ 1.4, 11.9 GET nLen PICTURE "999" OF oDlg SIZE 25, 11 UPDATE

   @ 1.4, 15.4 GET nDec PICTURE "999" OF oDlg SIZE 25, 11 WHEN cType = "Number" UPDATE
   
   @ 0.9, 26 BUTTON "&Add" OF oDlg SIZE 45, 13 ;
      ACTION AddField( @aFields, @cFieldName, @cType, @nLen, @nDec, oGet, oBrw )

   @ 2.2, 2 SAY "Fields" OF oDlg SIZE 40, 8
   
   @ 3.2, 1 XBROWSE oBrw ARRAY aFields AUTOCOLS ;
      HEADERS "Name", "Type", "Len", "Dec" ;
      COLSIZES 90, 55, 40, 40 ;
      SIZE 140, 130 OF oDlg

   oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }    
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   oBrw:CreateFromCode()

   @ 2.4, 26 BUTTON "&Edit" OF oDlg SIZE 45, 13

   @ 3.4, 26 BUTTON "&Delete" OF oDlg SIZE 45, 13

   @ 4.4, 26 BUTTON "Move &Up" OF oDlg SIZE 45, 13 ;
      ACTION If( oBrw:nArrayAt > 1,;
                 ( aTemp := aFields[ oBrw:nArrayAt ],;
                   aFields[ oBrw:nArrayAt ] := aFields[ oBrw:nArrayAt - 1 ],;
                   aFields[ oBrw:nArrayAt - 1 ] := aTemp,;
                   oBrw:GoUp() ),) 

   @ 5.4, 26 BUTTON "Move D&own" OF oDlg SIZE 45, 13 ;
      ACTION If( oBrw:nArrayAt < Len( aFields ),;
                 ( aTemp := aFields[ oBrw:nArrayAt ],;
                   aFields[ oBrw:nArrayAt ] := aFields[ oBrw:nArrayAt + 1 ],;
                   aFields[ oBrw:nArrayAt + 1 ] := aTemp,;
                   oBrw:GoDown() ),) 

   @ 12.1, 2 SAY "DBF Name:" OF oDlg SIZE 30, 8

   @ 14, 6 GET cDbfName PICTURE "!!!!!!!!!!!!" OF oDlg SIZE 100, 11

   @ 10, 26 BUTTON "&Create" OF oDlg SIZE 45, 13 ;
      ACTION ( If( ! Empty( cDbfName ) .and. Len( aFields ) > 0,;
          DbCreate( AllTrim( cDbfName ), aFields ),), oDlg:End(),;
          Open( hb_CurDrive() + ":\" + CurDir() + "\" + AllTrim( cDbfName ) ) )

   ACTIVATE DIALOG oDlg CENTERED

return nil

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

function AddField( aFields, cFieldName, cType, nLen, nDec, oGet, oBrw )

   if Empty( cFieldName )
      oGet:SetPos( 0 )
      return nil
   endif   

   if Len( aFields ) == 1 .and. Empty( aFields[ 1 ][ 1 ] )
      aFields = { { cFieldName, Upper( Left( cType, 1 ) ), nLen, nDec } }
   else   
      AAdd( aFields, { cFieldName, Upper( Left( cType, 1 ) ), nLen, nDec } )
   endif
      
   oBrw:SetArray( aFields )
   oGet:VarPut( cFieldName := Space( 10 ) )
   oGet:SetPos( 0 )
   oGet:SetFocus()
   oBrw:GoBottom()
               
return nil

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

#pragma BEGINDUMP

#include <hbapi.h>
#include <hbapirdd.h>

HB_FUNC( ORDCONDGET )
{
   AREAP pArea = ( AREAP ) hb_rddGetCurrentWorkAreaPointer();
   
   if( pArea )
   {
      LPDBORDERCONDINFO lpdbOrdCondInfo = pArea->lpdbOrdCondInfo;
      
      if( lpdbOrdCondInfo && lpdbOrdCondInfo->abWhile )
         hb_retc( lpdbOrdCondInfo->abWhile );
      else
         hb_retc( "" );   
   }
   else
      hb_retc( "" );     
}

#pragma ENDDUMP

//----------------------------------------------------------------------------//  
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
TimStone
Posts: 2536
Joined: Fri Oct 07, 2005 1:45 pm
Location: Trabuco Canyon, CA USA
Contact:

Re: FiveDBU for 32/64 bits

Post by TimStone »

Antonio,

I imagine you will be "going there" but the utility will also need full search and replace capabilities.

Also, filters .

I was able to build and test a recent version ... MSVC with Harbour ... but I was missing a few bmps.

Tim
Tim Stone
http://www.MasterLinkSoftware.com
timstone@masterlinksoftware.com
Using: FWH 19.06 with Harbour 3.2.0 / Microsoft Visual Studio Community 2019
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: FiveDBU for 32/64 bits

Post by Antonio Linares »

DELETE msg for Deleted records also a different text color

Code: Select all

#include "FiveWin.ch"
#include "xbrowse.ch"

#ifdef __XHARBOUR__
   #define hb_CurDrive() CurDrive()
#endif   

REQUEST DBFCDX

static oWndMain, oMruDBFs, aSearches := {}

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

function Main()

   local oBar, oBmpTiled
   
   SET DATE FORMAT TO "DD/MM/YYYY"

   SetDlgGradient( { { 1, RGB( 199, 216, 237 ), RGB( 237, 242, 248 ) } } )

   DEFINE BITMAP oBmpTiled RESOURCE "background"

   DEFINE WINDOW oWndMain TITLE "FiveDBU" MDI MENU BuildMenu()

   DEFINE BUTTONBAR oBar OF oWndMain 2010 SIZE 70, 70
   
   DEFINE BUTTON OF oBar PROMPT "New" RESOURCE "new" ACTION New()

   DEFINE BUTTON OF oBar PROMPT "Open" RESOURCE "open" ACTION Open()

   DEFINE BUTTON OF oBar PROMPT "Prev" RESOURCE "prev" ;
      ACTION oWndMain:PrevWindow() GROUP WHEN Len( oWndMain:oWndClient:aWnd ) > 1

   DEFINE BUTTON OF oBar PROMPT "Next" RESOURCE "next" ;
      ACTION oWndMain:NextWindow() WHEN Len( oWndMain:oWndClient:aWnd ) > 1

   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
      ACTION oWndMain:End() GROUP

   DEFINE MSGBAR PROMPT "FiveDBU 32/64 bits, (c) FiveTech Software 2012" ;
      OF oWndMain 2010 KEYBOARD DATE

   ACTIVATE WINDOW oWndMain MAXIMIZED ;
      VALID MsgYesNo( "Want to end ?" ) ;
      ON PAINT DrawTiled( hDC, oWndMain, oBmpTiled )
   
   oBmpTiled:End()      

return nil

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

function BuildMenu()

   local oMenu
   
   MENU oMenu
      MENUITEM "Files"
      MENU
         MENUITEM "New..."
         MENUITEM "Open..." ACTION Open()
         SEPARATOR
         MENUITEM "Recent files"
         MENU
            MRU oMruDBFs ;
               FILENAME ".\FiveDBU.ini" ;    // .INI to manipulate. '\.' for local
               SECTION  "Recent DBF files" ; // The name of the INI section
               ACTION   Open( cMruItem ) ;   // cMruItem is automatically provided
               MESSAGE  "Open this file" ;   // The message for all of them
               SIZE     10
         ENDMENU       

         SEPARATOR
         MENUITEM "Exit" ACTION oWndMain:End()
      ENDMENU
      
      // oMenu:AddEdit()
      oMenu:AddMdi()
      oMenu:AddHelp( "FiveDBU", "(c) FiveTech Software 2012" )
   ENDMENU
   
return oMenu      

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

function Open( cFileName )

   local oWnd, oBar, oBrw, oMsgBar, oPopup, cAlias, n, cClrBack
   
   DEFAULT cFileName := cGetFile( "*.dbf", "Please select a DBF" )
   
   if Empty( cFileName )
      return nil
   endif   
   
   if ! "." $ cFileName
      cFileName += ".dbf"
   endif   
   
   if ! File( cFileName )
      MsgStop( "File not found: " + cFileName )
      return nil
   endif
   
   if File( cFileNoExt( cFileName ) + ".ntx" )
      USE ( cFileName ) VIA "DBFNTX" NEW SHARED ;
         ALIAS ( cGetNewAlias( cFileName( cFileNoExt( cFileName ) ) ) )
   else   
      USE ( cFileName ) VIA "DBFCDX" NEW SHARED ;
         ALIAS ( cGetNewAlias( cFileName( cFileNoExt( cFileName ) ) ) )
      cAlias = Alias()
   endif        
   
   oMruDBFs:Save( cFileName )
   
   MENU oPopup POPUP
      MENUITEM "Natural order" ;
         ACTION ( ( cAlias )->( DbSetOrder( 0 ) ), oBrw:Refresh(), oBrw:SetFocus() )
      SEPARATOR   
      for n = 1 to 15
         if ! Empty( OrdName( n ) )
            if ! Empty( OrdName( 1 ) )
               DbSetOrder( OrdName( 1 ) )
               DbGoTop()
            endif   
            MENUITEM OrdName( n ) ;
               ACTION ( ( cAlias )->( DbSetOrder( oMenuItem:cPrompt ) ),;
                        oBrw:Refresh(), Eval( oBrw:bChange ), oBrw:SetFocus() )
         endif
      next    
   ENDMENU   
   
   DEFINE WINDOW oWnd TITLE "Browse " + cFileName MDICHILD

   DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70
   
   DEFINE BUTTON OF oBar PROMPT "Add" RESOURCE "add" ;
      ACTION ( ( oBrw:cAlias )->( DbAppend() ), oBrw:Refresh(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Edit" RESOURCE "edit" ;
      ACTION ( oBrw:cAlias )->( Edit() )

   DEFINE BUTTON OF oBar PROMPT "Del" RESOURCE "del" ;
      ACTION DelRecord( oBrw )

   DEFINE BUTTON OF oBar PROMPT "Search" RESOURCE "search" ;
      GROUP ACTION ( cAlias )->( Search( oBrw ) )

   DEFINE BUTTON OF oBar PROMPT "Index" RESOURCE "index" ;
      MENU oPopup ACTION ( cAlias )->( Indexes() )

   DEFINE BUTTON OF oBar PROMPT "Top" RESOURCE "prev" ;
      ACTION ( oBrw:GoTop(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Bottom" RESOURCE "next" ;
      ACTION ( oBrw:GoBottom(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Struct" RESOURCE "struct" ;
      ACTION ( oBrw:cAlias )->( Struct() ) GROUP

   DEFINE BUTTON OF oBar PROMPT "Report" RESOURCE "report" ;
      ACTION oBrw:Report()

   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ACTION oWnd:End() GROUP

   @ 0, 0 XBROWSE oBrw OF oWnd LINES ;
      ON CHANGE ( oMsgBar:cMsgDef := "Alias: " + Alias() + ;
                                     " RecNo: " + AllTrim( Str( RecNo() ) ) + "/" + ;
                                     AllTrim( Str( RecCount() ) ) + ;
                                     "  Ordered by: " + OrdName() + ;
                                     If( ( oBrw:cAlias )->( Deleted() ), "DELETED", "" ),;
                                     oMsgBar:Refresh() )

   oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, CLR_BLACK ),;
                           RGB( 198, 255, 198 ) }, ;
                         { If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, CLR_BLACK ),;
                           RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, CLR_WHITE ),;
                           RGB( 0x33, 0x66, 0xCC ) } }
   cClrBack = Eval( oBrw:bClrSelFocus )[ 2 ]                                              
   oBrw:bClrSelFocus = { || { If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, CLR_WHITE ),;
                              cClrBack } }                      
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   
   oBrw:CreateFromCode()
   oBrw:SetFocus()
   oBrw:bLDblClick = { || ( oBrw:cAlias )->( Edit() ) }                      
   
   oWnd:oClient = oBrw

   DEFINE MSGBAR oMsgBar PROMPT "Alias: " + Alias() + " RecNo: " + ;
      AllTrim( Str( RecNo() ) ) + "/" + ;
      AllTrim( Str( RecCount() ) ) + ;
      "  Ordered by: " + OrdName() + ;
      If( ( oBrw:cAlias )->( Deleted() ), "DELETED", "" ) ;
      OF oWnd 2010 
   
   ACTIVATE WINDOW oWnd ;
      VALID ( ( cAlias )->( DbCloseArea() ), oBrw:cAlias := "", .T. )
   
return nil   

//----------------------------------------------------------------------------//
   
function DelRecord( oBrw )

   if ! ( oBrw:cAlias )->( Deleted() ) 
      if ! MsgYesNo( "Want to delete this record ?" )
         return nil
      endif   
      ( oBrw:cAlias )->( DbRLock() )   
      ( oBrw:cAlias )->( DbDelete() )   
      ( oBrw:cAlias )->( DbUnlock() )   
   else
      ( oBrw:cAlias )->( DbRLock() )   
      ( oBrw:cAlias )->( DbRecall() )   
      ( oBrw:cAlias )->( DbUnlock() )         
      MsgInfo( "UnDeleted record" )
   endif
   
   Eval( oBrw:bChange )
   oBrw:Refresh()

return nil   

//----------------------------------------------------------------------------//
   
function Edit()

   local oWnd, aRecord := ( Alias() )->( LoadRecord() ), oBar, oBrw, oMsgBar
   local cAlias := Alias(), oBtnSave, nRecNo := ( Alias() )->( RecNo() )
   
   DEFINE WINDOW oWnd TITLE "Edit " + Alias() MDICHILD

   oWndMain:oBar:AEvalWhen()

   DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70
   
   DEFINE BUTTON oBtnSave OF oBar PROMPT "Save" RESOURCE "save" ;
      ACTION ( ( cAlias )->( SaveRecord( aRecord, nRecNo ) ), oBtnSave:Disable() )

   oBtnSave:Disable()

   DEFINE BUTTON OF oBar PROMPT "Prev" RESOURCE "prev" ;
      ACTION ( ( cAlias )->( DbSkip( -1 ) ),;
               oBrw:SetArray( aRecord := ( cAlias )->( LoadRecord() ) ),;
               oBrw:SetFocus(), Eval( oBrw:bChange ) ) GROUP

   DEFINE BUTTON OF oBar PROMPT "Next" RESOURCE "next" ;
      ACTION ( ( cAlias )->( DbSkip( 1 ) ),;
               If( ( cAlias )->( Eof() ), ( cAlias )->( DbSkip( -1 ) ),),;
               oBrw:SetArray( aRecord := ( cAlias )->( LoadRecord() ) ),;
               oBrw:SetFocus(), Eval( oBrw:bChange ) ) GROUP

   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
      ACTION oWnd:End() GROUP

   @ 0, 0 XBROWSE oBrw OF oWnd ARRAY aRecord AUTOCOLS LINES ;
      HEADERS "FieldName", "Value" COLSIZES 150, 400 FASTEDIT ;
      ON CHANGE ( ( cAlias )->( SetEditType( oBrw, oBtnSave ) ),;
                  oMsgBar:cMsgDef := " RecNo: " + AllTrim( Str( ( cAlias )->( RecNo() ) ) ) + ;
                                 "/" + AllTrim( Str( ( cAlias )->( RecCount() ) ) ),;
                  oMsgBar:Refresh() )                 

   oBrw:nEditTypes = EDIT_GET
   oBrw:aCols[ 1 ]:nEditType = 0 // Don't allow to edit first column
   oBrw:aCols[ 2 ]:bOnChange = { || oBtnSave:Enable() }
   oBrw:aCols[ 2 ]:lWillShowABtn = .T.
   oBrw:nMarqueeStyle = MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }                      
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   oBrw:CreateFromCode()
   oBrw:SetFocus()
   
   oWnd:oClient = oBrw

   DEFINE MSGBAR oMsgBar ;
      PROMPT " RecNo: " + AllTrim( Str( ( cAlias )->( RecNo() ) ) ) + "/" + ;
      AllTrim( Str( ( cAlias )->( RecCount() ) ) ) OF oWnd 2010
   
   ACTIVATE WINDOW oWnd
   
return nil      

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

function SetEditType( oBrw, oBtnSave )

   local cType := FieldType( oBrw:nArrayAt )
   
   do case
      case cType == "M"
           oBrw:aCols[ 2 ]:nEditType = EDIT_BUTTON
           oBrw:aCols[ 2 ]:bEditBlock = { | c | c := oBrw:aRow[ 2 ],;
                                               MemoEdit( @oBrw:aRow[ 2 ], FieldName( oBrw:nArrayAt ) ),;
                                               If( ! c == oBrw:aRow[ 2 ], oBtnSave:Enable(),),;
                                               oBrw:aRow[ 2 ] }
   
      case cType == "D"
           oBrw:aCols[ 2 ]:nEditType = EDIT_BUTTON
           oBrw:aCols[ 2 ]:bEditBlock = { || If( ! Empty( oBrw:aRow[ 2 ] ) .and. ;
                                                 ! AllTrim( oBrw:aRow[ 2 ] ) == "/  /",;
                                             DToC( MsgDate( CtoD( oBrw:aRow[ 2 ] ) ) ),;
                                             DToC( MsgDate( Date() ) ) ) }
   
      case cType == "L"
           oBrw:aCols[ 2 ]:nEditType = EDIT_LISTBOX
           oBrw:aCols[ 2 ]:aEditListTxt   = { ".T.", ".F." }
           
      otherwise
           oBrw:aCols[ 2 ]:nEditType = EDIT_GET
   endcase
   
return nil              

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

function IndexBuilder()

   local oDlg, cKey := Space( 80 )
   
   DEFINE DIALOG oDlg TITLE "Index builder" SIZE 600, 500 

   oDlg:lDesign = .T.

   @ 0.5,  2 SAY "Index on" OF oDlg SIZE 40, 8

   @ 1.4, 1 GET cKey OF oDlg SIZE 140, 11 ACTION ExpBuilder()
   
   @ 0.5, 15 SAY "Tag" OF oDlg SIZE 40, 8
   
   ACTIVATE DIALOG oDlg CENTERED

return nil

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

function Indexes()

   local oWnd, oBar, oBrw, oMsgBar
   local cAlias := Alias(), aIndexes := {}, n 
   
   for n = 1 to 15
      if ! Empty( OrdName( n ) )
         AAdd( aIndexes, { n,;
                           OrdName( n ),;
                           OrdKey( n ),;
                           OrdFor( n ),;
                           OrdBagName( n ),;
                           OrdBagExt( n ) } )
      endif   
   next    
   
   DEFINE WINDOW oWnd TITLE "Indexes of " + Alias() MDICHILD

   oWndMain:oBar:AEvalWhen()

   DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70

   DEFINE BUTTON OF oBar PROMPT "Add" RESOURCE "add" ;
      ACTION ( MsgInfo( "Add Tag" ), oBrw:Refresh(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Edit" RESOURCE "edit" ;
      ACTION ( MsgInfo( "Edit" ) )

   DEFINE BUTTON OF oBar PROMPT "Del" RESOURCE "del" ;
      ACTION If( MsgYesNo( "Want to delete this tag ?" ),;
                ( ( cAlias )->( OrdBagClear( oBrw:nArrayAt ) ), oBrw:Refresh() ),)
   
   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
      ACTION oWnd:End() GROUP

   @ 0, 0 XBROWSE oBrw OF oWnd ARRAY aIndexes AUTOCOLS LINES ;
      HEADERS "Order", "TagName", "Expression", "For", "BagName", "BagExt" ;
      COLSIZES 50, 150, 400, 400, 150, 150

   oBrw:nMarqueeStyle = MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }                      
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   oBrw:CreateFromCode()
   oBrw:SetFocus()
   
   oWnd:oClient = oBrw

   DEFINE MSGBAR oMsgBar 2010
   
   ACTIVATE WINDOW oWnd 

return nil

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

function ExpBuilder()

   local oDlg
   
   DEFINE DIALOG oDlg TITLE "Expression builder"
   
   ACTIVATE DIALOG oDlg CENTERED

return nil

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

function LoadRecord()

   local aRecord := {}, n
   
   for n = 1 to FCount()
      AAdd( aRecord, { FieldName( n ), FieldGet( n ) } )
   next
   
return aRecord      
   
//----------------------------------------------------------------------------// 

function Search( oBrw )

   local oDlg, oCbx, cSearch := Space( 50 )
   local nRecNo := RecNo(), lInc := .T.
   
   DEFINE DIALOG oDlg TITLE "Search: " + Alias() SIZE 400, 200
   
   @ 0.5, 1.5 SAY "Ordered by: " + OrdName() OF oDlg
   
   @ 1.2, 1.5 SAY "Key: " + OrdKey() OF oDlg
   
   @ 2.4, 1.2 COMBOBOX oCbx VAR cSearch ITEMS aSearches OF oDlg SIZE 180, 150 ;
     STYLE CBS_DROPDOWN
   
   oCbx:oGet:bChange = { || DbSeek( AllTrim( oCbx:GetText() ), lInc ), oBrw:Refresh() } 
   
   @ 3.7, 1.5 CHECKBOX lInc PROMPT "&Incremental" OF oDlg SIZE 80, 10
   
   @ 4, 7 BUTTON "&Ok" OF oDlg SIZE 45, 13 ;
      ACTION ( If( ! DbSeek( AllTrim( cSearch ), lInc ), DbGoTo( nRecNo ),),;
               AAdd( aSearches, AllTrim( cSearch ) ), oDlg:End() )

   @ 4, 18 BUTTON "&Cancel" OF oDlg SIZE 45, 13 ACTION oDlg:End()
   
   ACTIVATE DIALOG oDlg CENTERED
   
return nil   

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

function SaveRecord( aRecord, nRecNo )

   local n

   ( Alias() )->( DbGoTo( nRecNo ) )
   
   if ( Alias() )->( DbRLock( nRecNo ) )
      for n = 1 to Len( aRecord )
         ( Alias() )->( FieldPut( n, aRecord[ n ][ 2 ] ) )
      next
      ( Alias() )->( DbUnLock() )
      MsgInfo( "Record updated" )
   else
      MsgAlert( "Record in use, please try it again" )
   endif         

return nil      

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

function Struct()

   local oDlg, oBrw, aFields := DbStruct()
   
   DEFINE DIALOG oDlg TITLE Alias() + " fields" SIZE 400, 400

   @ 0, 0 XBROWSE oBrw ARRAY aFields AUTOCOLS LINES ;
      HEADERS "Name", "Type", "Len", "Dec" ;
      COLSIZES 150, 50, 80, 80

   oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }                      
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   
   oBrw:CreateFromCode()
      
   oDlg:oClient = oBrw
   
   ACTIVATE DIALOG oDlg CENTERED ;
      ON INIT ( BuildStructBar( oDlg, oBrw ), oDlg:Resize(), oBrw:SetFocus() )
   
return nil   

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

function BuildStructBar( oDlg, oBrw )

   local oBar

   DEFINE BUTTONBAR oBar OF oDlg 2010 SIZE 70, 70
   
   DEFINE BUTTON OF oBar PROMPT "Code" RESOURCE "code" ;
      ACTION ( TxtStruct(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
      ACTION oDlg:End() GROUP

return nil

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

function TxtStruct()

   local cCode := "local aFields := { ", n
   
   for n = 1 to FCount()
      if n > 1
         cCode += Space( 27 )
      endif   
      cCode += '{ "' + FieldName( n ) + '", "' + ;
               FieldType( n ) + '", ' + ;
               AllTrim( Str( FieldLen( n ) ) ) + ", " + ;
               AllTrim( Str( FieldDec( n ) ) ) + " },;" + CRLF
   next
   
   cCode = SubStr( cCode, 1, Len( cCode ) - 4 ) + " }"
   
   MemoEdit( cCode, "Code" )

return nil

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

function New()

   local oDlg, oGet, oBrw 
   local cFieldName := Space( 10 ), cType, nLen := 10, nDec := 0
   local aFields := { Array( 4 ) }, cDbfName := Space( 8 ), aTemp
   
   DEFINE DIALOG oDlg TITLE "DBF builder" SIZE 415, 400

   @ 0.5,  2 SAY "Field Name" OF oDlg SIZE 40, 8
   @ 0.5, 10 SAY "Type" OF oDlg SIZE 40, 8
   @ 0.5, 17 SAY "Len" OF oDlg SIZE 40, 8
   @ 0.5, 22 SAY "Dec" OF oDlg SIZE 20, 8 
   
   @ 1.4, 1 GET oGet VAR cFieldName PICTURE "!!!!!!!!!!" OF oDlg SIZE 41, 11
   
   @ 1.3, 6.5 COMBOBOX cType ITEMS { "Character", "Number", "Date", "Logical", "Memo" } ;
      OF oDlg ON CHANGE ( If( cType == "Character", ( nLen := 10, nDec := 0 ),),;
                          If( cType == "Number", nDec := 0,),;
                          If( cType == "Date", ( nLen := 8, nDec := 0 ),),;
                          If( cType == "Logical", ( nLen := 1, nDec := 0 ),),;
                          If( cType == "Memo", ( nLen := 10, nDec := 0 ),),;
                             oDlg:Update() )
                             
   @ 1.4, 11.9 GET nLen PICTURE "999" OF oDlg SIZE 25, 11 UPDATE

   @ 1.4, 15.4 GET nDec PICTURE "999" OF oDlg SIZE 25, 11 WHEN cType = "Number" UPDATE
   
   @ 0.9, 26 BUTTON "&Add" OF oDlg SIZE 45, 13 ;
      ACTION AddField( @aFields, @cFieldName, @cType, @nLen, @nDec, oGet, oBrw )

   @ 2.2, 2 SAY "Fields" OF oDlg SIZE 40, 8
   
   @ 3.2, 1 XBROWSE oBrw ARRAY aFields AUTOCOLS ;
      HEADERS "Name", "Type", "Len", "Dec" ;
      COLSIZES 90, 55, 40, 40 ;
      SIZE 140, 130 OF oDlg

   oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }    
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   oBrw:CreateFromCode()

   @ 2.4, 26 BUTTON "&Edit" OF oDlg SIZE 45, 13

   @ 3.4, 26 BUTTON "&Delete" OF oDlg SIZE 45, 13

   @ 4.4, 26 BUTTON "Move &Up" OF oDlg SIZE 45, 13 ;
      ACTION If( oBrw:nArrayAt > 1,;
                 ( aTemp := aFields[ oBrw:nArrayAt ],;
                   aFields[ oBrw:nArrayAt ] := aFields[ oBrw:nArrayAt - 1 ],;
                   aFields[ oBrw:nArrayAt - 1 ] := aTemp,;
                   oBrw:GoUp() ),) 

   @ 5.4, 26 BUTTON "Move D&own" OF oDlg SIZE 45, 13 ;
      ACTION If( oBrw:nArrayAt < Len( aFields ),;
                 ( aTemp := aFields[ oBrw:nArrayAt ],;
                   aFields[ oBrw:nArrayAt ] := aFields[ oBrw:nArrayAt + 1 ],;
                   aFields[ oBrw:nArrayAt + 1 ] := aTemp,;
                   oBrw:GoDown() ),) 

   @ 12.1, 2 SAY "DBF Name:" OF oDlg SIZE 30, 8

   @ 14, 6 GET cDbfName PICTURE "!!!!!!!!!!!!" OF oDlg SIZE 100, 11

   @ 10, 26 BUTTON "&Create" OF oDlg SIZE 45, 13 ;
      ACTION ( If( ! Empty( cDbfName ) .and. Len( aFields ) > 0,;
          DbCreate( AllTrim( cDbfName ), aFields ),), oDlg:End(),;
          Open( hb_CurDrive() + ":\" + CurDir() + "\" + AllTrim( cDbfName ) ) )

   ACTIVATE DIALOG oDlg CENTERED

return nil

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

function AddField( aFields, cFieldName, cType, nLen, nDec, oGet, oBrw )

   if Empty( cFieldName )
      oGet:SetPos( 0 )
      return nil
   endif   

   if Len( aFields ) == 1 .and. Empty( aFields[ 1 ][ 1 ] )
      aFields = { { cFieldName, Upper( Left( cType, 1 ) ), nLen, nDec } }
   else   
      AAdd( aFields, { cFieldName, Upper( Left( cType, 1 ) ), nLen, nDec } )
   endif
      
   oBrw:SetArray( aFields )
   oGet:VarPut( cFieldName := Space( 10 ) )
   oGet:SetPos( 0 )
   oGet:SetFocus()
   oBrw:GoBottom()
               
return nil

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

#pragma BEGINDUMP

#include <hbapi.h>
#include <hbapirdd.h>

HB_FUNC( ORDCONDGET )
{
   AREAP pArea = ( AREAP ) hb_rddGetCurrentWorkAreaPointer();
   
   if( pArea )
   {
      LPDBORDERCONDINFO lpdbOrdCondInfo = pArea->lpdbOrdCondInfo;
      
      if( lpdbOrdCondInfo && lpdbOrdCondInfo->abWhile )
         hb_retc( lpdbOrdCondInfo->abWhile );
      else
         hb_retc( "" );   
   }
   else
      hb_retc( "" );     
}

#pragma ENDDUMP

//----------------------------------------------------------------------------//  
Image
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: FiveDBU for 32/64 bits

Post by Antonio Linares »

More recent version, full source code included:

http://code.google.com/p/fivewin-contri ... p&can=2&q=
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: FiveDBU for 32/64 bits

Post by Antonio Linares »

Enhanced version:

Code: Select all

#include "FiveWin.ch"
#include "xbrowse.ch"

#ifdef __XHARBOUR__
   #define hb_CurDrive() CurDrive()
#endif   

REQUEST DBFCDX

static oWndMain, oMruDBFs, aSearches := {}

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

function Main()

   local oBar, oBmpTiled
   
   SET DATE FORMAT TO "DD/MM/YYYY"

   SetDlgGradient( { { 1, RGB( 199, 216, 237 ), RGB( 237, 242, 248 ) } } )

   DEFINE BITMAP oBmpTiled RESOURCE "background"

   DEFINE WINDOW oWndMain TITLE "FiveDBU" MDI MENU BuildMenu()

   DEFINE BUTTONBAR oBar OF oWndMain 2010 SIZE 70, 70
   
   DEFINE BUTTON OF oBar PROMPT "New" RESOURCE "new" ACTION New()

   DEFINE BUTTON OF oBar PROMPT "Open" RESOURCE "open" ACTION Open()

   DEFINE BUTTON OF oBar PROMPT "Prev" RESOURCE "prev" ;
      ACTION oWndMain:PrevWindow() GROUP WHEN Len( oWndMain:oWndClient:aWnd ) > 1

   DEFINE BUTTON OF oBar PROMPT "Next" RESOURCE "next" ;
      ACTION oWndMain:NextWindow() WHEN Len( oWndMain:oWndClient:aWnd ) > 1

   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
      ACTION oWndMain:End() GROUP

   DEFINE MSGBAR PROMPT "FiveDBU 32/64 bits, (c) FiveTech Software 2012" ;
      OF oWndMain 2010 KEYBOARD DATE

   ACTIVATE WINDOW oWndMain MAXIMIZED ;
      VALID MsgYesNo( "Want to end ?" ) ;
      ON PAINT DrawTiled( hDC, oWndMain, oBmpTiled )
   
   oBmpTiled:End()      

return nil

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

function BuildMenu()

   local oMenu
   
   MENU oMenu
      MENUITEM "Files"
      MENU
         MENUITEM "New..."
         MENUITEM "Open..." ACTION Open()
         SEPARATOR
         MENUITEM "Recent files"
         MENU
            MRU oMruDBFs ;
               FILENAME ".\FiveDBU.ini" ;    // .INI to manipulate. '\.' for local
               SECTION  "Recent DBF files" ; // The name of the INI section
               ACTION   Open( cMruItem ) ;   // cMruItem is automatically provided
               MESSAGE  "Open this file" ;   // The message for all of them
               SIZE     10
         ENDMENU       

         SEPARATOR
         MENUITEM "Exit" ACTION oWndMain:End()
      ENDMENU
      
      // oMenu:AddEdit()
      oMenu:AddMdi()
      oMenu:AddHelp( "FiveDBU", "(c) FiveTech Software 2012" )
   ENDMENU
   
return oMenu      

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

function Open( cFileName )

   local oWnd, oBar, oBrw, oMsgBar, oMsgDeleted, oMsgTagName
   local oPopup, cAlias, n, cClrBack, nTags
   
   DEFAULT cFileName := cGetFile( "*.dbf", "Please select a DBF" )
   
   if Empty( cFileName )
      return nil
   endif   
   
   if ! "." $ cFileName
      cFileName += ".dbf"
   endif   
   
   if ! File( cFileName )
      MsgStop( "File not found: " + cFileName )
      return nil
   endif
   
   if File( cFileNoExt( cFileName ) + ".ntx" )
      USE ( cFileName ) VIA "DBFNTX" NEW SHARED ;
         ALIAS ( cGetNewAlias( cFileName( cFileNoExt( cFileName ) ) ) )
   else   
      USE ( cFileName ) VIA "DBFCDX" NEW SHARED ;
         ALIAS ( cGetNewAlias( cFileName( cFileNoExt( cFileName ) ) ) )
      cAlias = Alias()
   endif        
   
   oMruDBFs:Save( cFileName )
   
   MENU oPopup POPUP
      MENUITEM "Natural order" ;
         ACTION ( ( cAlias )->( DbSetOrder( 0 ) ), oBrw:Refresh(), oBrw:SetFocus(),;
                  ( cAlias )->( Eval( oBrw:bChange ) ) )
      
      if ( nTags := ( cAlias )->( OrdTagsCount() ) ) > 0
         SEPARATOR
      endif   
      
      for n = 1 to nTags
         if ! Empty( OrdName( n ) )
            if ! Empty( OrdName( 1 ) )
               DbSetOrder( OrdName( 1 ) )
               DbGoTop()
            endif   
            MENUITEM OrdName( n ) ;
               ACTION ( ( cAlias )->( DbSetOrder( oMenuItem:cPrompt ) ),;
                        oBrw:Refresh(), ( cAlias )->( Eval( oBrw:bChange ) ), oBrw:SetFocus() )
         endif
      next    
   ENDMENU   
   
   DEFINE WINDOW oWnd TITLE "Browse " + cFileName MDICHILD

   DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70
   
   DEFINE BUTTON OF oBar PROMPT "Add" RESOURCE "add" ;
      ACTION ( ( oBrw:cAlias )->( DbAppend() ), oBrw:Refresh(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Edit" RESOURCE "edit" ;
      ACTION ( oBrw:cAlias )->( Edit() )

   DEFINE BUTTON OF oBar PROMPT "Del" RESOURCE "del" ;
      ACTION ( obrw:cAlias )->( DelRecord( oBrw ) )

   DEFINE BUTTON OF oBar PROMPT "Search" RESOURCE "search" ;
      GROUP ACTION ( cAlias )->( Search( oBrw ) )

   DEFINE BUTTON OF oBar PROMPT "Index" RESOURCE "index" ;
      MENU oPopup ACTION ( cAlias )->( Indexes() )

   DEFINE BUTTON OF oBar PROMPT "Top" RESOURCE "prev" ;
      ACTION ( oBrw:GoTop(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Bottom" RESOURCE "next" ;
      ACTION ( oBrw:GoBottom(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Struct" RESOURCE "struct" ;
      ACTION ( oBrw:cAlias )->( Struct() ) GROUP

   DEFINE BUTTON OF oBar PROMPT "Report" RESOURCE "report" ;
      ACTION oBrw:Report()

   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ACTION oWnd:End() GROUP

   @ 0, 0 XBROWSE oBrw OF oWnd LINES ;
      ON CHANGE ( oMsgBar:cMsgDef := "Alias: " + Alias() + ;
                                     " RecNo: " + AllTrim( Str( RecNo() ) ) + "/" + ;
                                     AllTrim( Str( RecCount() ) ),;
                                     oMsgBar:Refresh(),;
                                     oMsgTagName:SetText( "Ordered by: " + If( ! Empty( OrdName() ), OrdName(), "Natural order" ) ),;
                                     oMsgDeleted:SetText( If( ( oBrw:cAlias )->( Deleted() ),;
                                     "DELETED", "NON DELETED" ) ),;
                                     oMsgDeleted:SetBitmap( If( ( oBrw:cAlias )->( Deleted() ),;
                                     "deleted", "nondeleted" ) ) )

   oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, CLR_BLACK ),;
                           RGB( 198, 255, 198 ) }, ;
                         { If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, CLR_BLACK ),;
                           RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, CLR_WHITE ),;
                           RGB( 0x33, 0x66, 0xCC ) } }
   cClrBack = Eval( oBrw:bClrSelFocus )[ 2 ]                                              
   oBrw:bClrSelFocus = { || { If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, CLR_WHITE ),;
                              cClrBack } }                      
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   
   oBrw:CreateFromCode()
   oBrw:SetFocus()
   oBrw:bLDblClick = { || ( oBrw:cAlias )->( Edit() ) }                      
   
   oWnd:oClient = oBrw

   DEFINE MSGBAR oMsgBar PROMPT "Alias: " + Alias() + " | RecNo: " + ;
      AllTrim( Str( RecNo() ) ) + "/" + ;
      AllTrim( Str( RecCount() ) ) ;
      OF oWnd 2010 

   DEFINE MSGITEM oMsgTagName OF oMsgBar ;
          PROMPT "Ordered by: " + ;
          If( ! Empty( ( oBrw:cAlias )->( OrdName() ) ),;
              ( oBrw:cAlias )->( OrdName() ), "Natural order" ) ;
          SIZE 150

   DEFINE MSGITEM oMsgDeleted OF oMsgBar ;
          PROMPT If( ( oBrw:cAlias )->( Deleted() ), "DELETED", "NON DELETED" ) ;
          SIZE 130 ;
          BITMAPS "nondeleted" ;
          ACTION ( oBrw:cAlias )->( DelRecord( oBrw, oMsgDeleted ) )   
          
   ACTIVATE WINDOW oWnd ;
      VALID ( ( cAlias )->( DbCloseArea() ), oBrw:cAlias := "", .T. )
   
return nil   

//----------------------------------------------------------------------------//
   
function DelRecord( oBrw, oMsgDeleted )

   if ! Deleted() 
      if ! MsgYesNo( "Want to delete this record ?" )
         return nil
      endif   
      DbRLock()   
      DbDelete()   
      DbUnlock()   
      oMsgDeleted:SetText( "DELETED" )
      oMsgDeleted:SetBitmap( "deleted" )
   else
      DbRLock()   
      DbRecall()   
      DbUnlock()         
      oMsgDeleted:SetText( "NON DELETED" )
      oMsgDeleted:SetBitmap( "nondeleted" )
      MsgInfo( "UnDeleted record" )
   endif
   
   Eval( oBrw:bChange )
   oBrw:Refresh()

return nil   

//----------------------------------------------------------------------------//
   
function Edit()

   local oWnd, aRecord := ( Alias() )->( LoadRecord() ), oBar, oBrw, oMsgBar
   local cAlias := Alias(), oBtnSave, nRecNo := ( Alias() )->( RecNo() )
   local oMsgDeleted
   
   DEFINE WINDOW oWnd TITLE "Edit " + Alias() MDICHILD

   oWndMain:oBar:AEvalWhen()

   DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70
   
   DEFINE BUTTON oBtnSave OF oBar PROMPT "Save" RESOURCE "save" ;
      ACTION ( ( cAlias )->( SaveRecord( aRecord, nRecNo ) ), oBtnSave:Disable() )

   oBtnSave:Disable()

   DEFINE BUTTON OF oBar PROMPT "Prev" RESOURCE "prev" ;
      ACTION GoPrevRecord( oBrw, aRecord, oMsgDeleted ) GROUP

   DEFINE BUTTON OF oBar PROMPT "Next" RESOURCE "next" ;
      ACTION GoNextRecord( oBrw, aRecord, oMsgDeleted ) GROUP

   DEFINE BUTTON OF oBar PROMPT "Report" RESOURCE "report" ;
      ACTION oBrw:Report()
      
   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
      ACTION oWnd:End() GROUP

   @ 0, 0 XBROWSE oBrw OF oWnd ARRAY aRecord AUTOCOLS LINES ;
      HEADERS "FieldName", "Value" COLSIZES 150, 400 FASTEDIT ;
      ON CHANGE ( ( cAlias )->( SetEditType( oBrw, oBtnSave ) ), oBrw:DrawLine( .T. ),;
                  oMsgBar:cMsgDef := " RecNo: " + AllTrim( Str( ( cAlias )->( RecNo() ) ) ) + ;
                                 "/" + AllTrim( Str( ( cAlias )->( RecCount() ) ) ),;
                  oMsgBar:Refresh() )                 

   oBrw:nEditTypes = EDIT_GET
   oBrw:aCols[ 1 ]:nEditType = 0 // Don't allow to edit first column
   oBrw:aCols[ 2 ]:bOnChange = { || oBtnSave:Enable() }
   oBrw:aCols[ 2 ]:lWillShowABtn = .T.
   oBrw:nMarqueeStyle = MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }                      
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   oBrw:CreateFromCode()
   oBrw:SetFocus()
   
   oWnd:oClient = oBrw

   DEFINE MSGBAR oMsgBar ;
      PROMPT " RecNo: " + AllTrim( Str( ( cAlias )->( RecNo() ) ) ) + "/" + ;
      AllTrim( Str( ( cAlias )->( RecCount() ) ) ) OF oWnd 2010

   DEFINE MSGITEM oMsgDeleted OF oMsgBar ;
          PROMPT If( ( cAlias )->( Deleted() ), "DELETED", "NON DELETED" ) ;
          SIZE 130 ;
          BITMAPS If( ( cAlias )->( Deleted() ), "deleted", "nondeleted" ) ;
          ACTION ( cAlias )->( DelRecord( oBrw, oMsgDeleted ) )   
   
   ACTIVATE WINDOW oWnd
   
return nil      

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

function GoPrevRecord( oBrw, aRecord, oMsgDeleted )

   DbSkip( -1 )
   
   oBrw:SetArray( aRecord := LoadRecord() )
   oBrw:SetFocus()
   Eval( oBrw:bChange )

   oMsgDeleted:SetText( If( Deleted(), "DELETED", "NON DELETED" ) )
   oMsgDeleted:SetBitmap( If( Deleted(), "deleted", "nondeleted" ) )
   
return nil

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

function GoNextRecord( oBrw, aRecord, oMsgDeleted )

   DbSkip( 1 )
   
   If Eof()
      DbSkip( -1 )
   else
      oBrw:SetArray( aRecord := LoadRecord() )
      oBrw:SetFocus()
      Eval( oBrw:bChange )
   endif   

   oMsgDeleted:SetText( If( Deleted(), "DELETED", "NON DELETED" ) )
   oMsgDeleted:SetBitmap( If( Deleted(), "deleted", "nondeleted" ) )
   
return nil

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

function SetEditType( oBrw, oBtnSave )

   local cType := FieldType( oBrw:nArrayAt )
   
   do case
      case cType == "M"
           oBrw:aCols[ 2 ]:nEditType = EDIT_BUTTON
           oBrw:aCols[ 2 ]:bEditBlock = { | c | c := oBrw:aRow[ 2 ],;
                                               MemoEdit( @oBrw:aRow[ 2 ], FieldName( oBrw:nArrayAt ) ),;
                                               If( ! c == oBrw:aRow[ 2 ], oBtnSave:Enable(),),;
                                               oBrw:aRow[ 2 ] }
   
      case cType == "D"
           oBrw:aCols[ 2 ]:nEditType = EDIT_BUTTON
           oBrw:aCols[ 2 ]:bEditBlock = { || If( ! Empty( oBrw:aRow[ 2 ] ) .and. ;
                                                 ! AllTrim( oBrw:aRow[ 2 ] ) == "/  /",;
                                             DToC( MsgDate( CtoD( oBrw:aRow[ 2 ] ) ) ),;
                                             DToC( MsgDate( Date() ) ) ) }
   
      case cType == "L"
           oBrw:aCols[ 2 ]:nEditType = EDIT_LISTBOX
           oBrw:aCols[ 2 ]:aEditListTxt   = { ".T.", ".F." }
           
      otherwise
           oBrw:aCols[ 2 ]:nEditType = EDIT_GET
   endcase
   
return nil              

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

function IndexBuilder()

   local oDlg, cKey := Space( 80 )
   
   DEFINE DIALOG oDlg TITLE "Index builder" SIZE 600, 500 

   oDlg:lDesign = .T.

   @ 0.5,  2 SAY "Index on" OF oDlg SIZE 40, 8

   @ 1.4, 1 GET cKey OF oDlg SIZE 140, 11 ACTION ExpBuilder()
   
   @ 0.5, 15 SAY "Tag" OF oDlg SIZE 40, 8
   
   ACTIVATE DIALOG oDlg CENTERED

return nil

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

function Indexes()

   local oWnd, oBar, oBrw, oMsgBar
   local cAlias := Alias(), aIndexes := {}, n 
   
   for n = 1 to 15
      if ! Empty( OrdName( n ) )
         AAdd( aIndexes, { n,;
                           OrdName( n ),;
                           OrdKey( n ),;
                           OrdFor( n ),;
                           OrdBagName( n ),;
                           OrdBagExt( n ) } )
      endif   
   next    
   
   DEFINE WINDOW oWnd TITLE "Indexes of " + Alias() MDICHILD

   oWndMain:oBar:AEvalWhen()

   DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70

   DEFINE BUTTON OF oBar PROMPT "Add" RESOURCE "add" ;
      ACTION ( MsgInfo( "Add Tag" ), oBrw:Refresh(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Edit" RESOURCE "edit" ;
      ACTION ( MsgInfo( "Edit" ) )

   DEFINE BUTTON OF oBar PROMPT "Del" RESOURCE "del" ;
      ACTION If( MsgYesNo( "Want to delete this tag ?" ),;
                ( ( cAlias )->( OrdBagClear( oBrw:nArrayAt ) ), oBrw:Refresh() ),)
   
   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
      ACTION oWnd:End() GROUP

   @ 0, 0 XBROWSE oBrw OF oWnd ARRAY aIndexes AUTOCOLS LINES ;
      HEADERS "Order", "TagName", "Expression", "For", "BagName", "BagExt" ;
      COLSIZES 50, 150, 400, 400, 150, 150

   oBrw:nMarqueeStyle = MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }                      
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   oBrw:CreateFromCode()
   oBrw:SetFocus()
   
   oWnd:oClient = oBrw

   DEFINE MSGBAR oMsgBar 2010
   
   ACTIVATE WINDOW oWnd 

return nil

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

function ExpBuilder()

   local oDlg
   
   DEFINE DIALOG oDlg TITLE "Expression builder"
   
   ACTIVATE DIALOG oDlg CENTERED

return nil

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

function LoadRecord()

   local aRecord := {}, n
   
   for n = 1 to FCount()
      AAdd( aRecord, { FieldName( n ), FieldGet( n ) } )
   next
   
return aRecord      
   
//----------------------------------------------------------------------------// 

function Search( oBrw )

   local oDlg, oCbx, cSearch := Space( 50 )
   local nRecNo := RecNo(), lInc := .T.
   
   DEFINE DIALOG oDlg TITLE "Search: " + Alias() SIZE 400, 200
   
   @ 0.5, 1.5 SAY "Ordered by: " + OrdName() OF oDlg
   
   @ 1.2, 1.5 SAY "Key: " + OrdKey() OF oDlg
   
   @ 2.4, 1.2 COMBOBOX oCbx VAR cSearch ITEMS aSearches OF oDlg SIZE 180, 150 ;
     STYLE CBS_DROPDOWN
   
   oCbx:oGet:bChange = { || DbSeek( AllTrim( oCbx:GetText() ), lInc ), oBrw:Refresh() } 
   
   @ 3.7, 1.5 CHECKBOX lInc PROMPT "&Incremental" OF oDlg SIZE 80, 10
   
   @ 4, 7 BUTTON "&Ok" OF oDlg SIZE 45, 13 ;
      ACTION ( If( ! DbSeek( AllTrim( cSearch ), lInc ), DbGoTo( nRecNo ),),;
               AAdd( aSearches, AllTrim( cSearch ) ), oDlg:End() )

   @ 4, 18 BUTTON "&Cancel" OF oDlg SIZE 45, 13 ACTION oDlg:End()
   
   ACTIVATE DIALOG oDlg CENTERED
   
return nil   

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

function SaveRecord( aRecord, nRecNo )

   local n

   ( Alias() )->( DbGoTo( nRecNo ) )
   
   if ( Alias() )->( DbRLock( nRecNo ) )
      for n = 1 to Len( aRecord )
         ( Alias() )->( FieldPut( n, aRecord[ n ][ 2 ] ) )
      next
      ( Alias() )->( DbUnLock() )
      MsgInfo( "Record updated" )
   else
      MsgAlert( "Record in use, please try it again" )
   endif         

return nil      

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

function Struct()

   local oDlg, oBrw, aFields := DbStruct()
   
   DEFINE DIALOG oDlg TITLE Alias() + " fields" SIZE 400, 400

   @ 0, 0 XBROWSE oBrw ARRAY aFields AUTOCOLS LINES ;
      HEADERS "Name", "Type", "Len", "Dec" ;
      COLSIZES 150, 50, 80, 80

   oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }                      
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   
   oBrw:CreateFromCode()
      
   oDlg:oClient = oBrw
   
   ACTIVATE DIALOG oDlg CENTERED ;
      ON INIT ( BuildStructBar( oDlg, oBrw ), oDlg:Resize(), oBrw:SetFocus() )
   
return nil   

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

function BuildStructBar( oDlg, oBrw )

   local oBar

   DEFINE BUTTONBAR oBar OF oDlg 2010 SIZE 70, 70
   
   DEFINE BUTTON OF oBar PROMPT "Code" RESOURCE "code" ;
      ACTION ( TxtStruct(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
      ACTION oDlg:End() GROUP

return nil

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

function TxtStruct()

   local cCode := "local aFields := { ", n
   
   for n = 1 to FCount()
      if n > 1
         cCode += Space( 27 )
      endif   
      cCode += '{ "' + FieldName( n ) + '", "' + ;
               FieldType( n ) + '", ' + ;
               AllTrim( Str( FieldLen( n ) ) ) + ", " + ;
               AllTrim( Str( FieldDec( n ) ) ) + " },;" + CRLF
   next
   
   cCode = SubStr( cCode, 1, Len( cCode ) - 4 ) + " }"
   
   MemoEdit( cCode, "Code" )

return nil

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

function New()

   local oDlg, oGet, oBrw 
   local cFieldName := Space( 10 ), cType, nLen := 10, nDec := 0
   local aFields := { Array( 4 ) }, cDbfName := Space( 8 ), aTemp
   
   DEFINE DIALOG oDlg TITLE "DBF builder" SIZE 415, 400

   @ 0.5,  2 SAY "Field Name" OF oDlg SIZE 40, 8
   @ 0.5, 10 SAY "Type" OF oDlg SIZE 40, 8
   @ 0.5, 17 SAY "Len" OF oDlg SIZE 40, 8
   @ 0.5, 22 SAY "Dec" OF oDlg SIZE 20, 8 
   
   @ 1.4, 1 GET oGet VAR cFieldName PICTURE "!!!!!!!!!!" OF oDlg SIZE 41, 11
   
   @ 1.3, 6.5 COMBOBOX cType ITEMS { "Character", "Number", "Date", "Logical", "Memo" } ;
      OF oDlg ON CHANGE ( If( cType == "Character", ( nLen := 10, nDec := 0 ),),;
                          If( cType == "Number", nDec := 0,),;
                          If( cType == "Date", ( nLen := 8, nDec := 0 ),),;
                          If( cType == "Logical", ( nLen := 1, nDec := 0 ),),;
                          If( cType == "Memo", ( nLen := 10, nDec := 0 ),),;
                             oDlg:Update() )
                             
   @ 1.4, 11.9 GET nLen PICTURE "999" OF oDlg SIZE 25, 11 UPDATE

   @ 1.4, 15.4 GET nDec PICTURE "999" OF oDlg SIZE 25, 11 WHEN cType = "Number" UPDATE
   
   @ 0.9, 26 BUTTON "&Add" OF oDlg SIZE 45, 13 ;
      ACTION AddField( @aFields, @cFieldName, @cType, @nLen, @nDec, oGet, oBrw )

   @ 2.2, 2 SAY "Fields" OF oDlg SIZE 40, 8
   
   @ 3.2, 1 XBROWSE oBrw ARRAY aFields AUTOCOLS ;
      HEADERS "Name", "Type", "Len", "Dec" ;
      COLSIZES 90, 55, 40, 40 ;
      SIZE 140, 130 OF oDlg

   oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW   
   oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
                         { CLR_BLACK, RGB( 198, 255, 198 ) }, ;
                         { CLR_BLACK, RGB( 232, 255, 232 ) } ) }
   oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }    
   oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
   oBrw:CreateFromCode()

   @ 2.4, 26 BUTTON "&Edit" OF oDlg SIZE 45, 13

   @ 3.4, 26 BUTTON "&Delete" OF oDlg SIZE 45, 13

   @ 4.4, 26 BUTTON "Move &Up" OF oDlg SIZE 45, 13 ;
      ACTION If( oBrw:nArrayAt > 1,;
                 ( aTemp := aFields[ oBrw:nArrayAt ],;
                   aFields[ oBrw:nArrayAt ] := aFields[ oBrw:nArrayAt - 1 ],;
                   aFields[ oBrw:nArrayAt - 1 ] := aTemp,;
                   oBrw:GoUp() ),) 

   @ 5.4, 26 BUTTON "Move D&own" OF oDlg SIZE 45, 13 ;
      ACTION If( oBrw:nArrayAt < Len( aFields ),;
                 ( aTemp := aFields[ oBrw:nArrayAt ],;
                   aFields[ oBrw:nArrayAt ] := aFields[ oBrw:nArrayAt + 1 ],;
                   aFields[ oBrw:nArrayAt + 1 ] := aTemp,;
                   oBrw:GoDown() ),) 

   @ 12.1, 2 SAY "DBF Name:" OF oDlg SIZE 30, 8

   @ 14, 6 GET cDbfName PICTURE "!!!!!!!!!!!!" OF oDlg SIZE 100, 11

   @ 10, 26 BUTTON "&Create" OF oDlg SIZE 45, 13 ;
      ACTION ( If( ! Empty( cDbfName ) .and. Len( aFields ) > 0,;
          DbCreate( AllTrim( cDbfName ), aFields ),), oDlg:End(),;
          Open( hb_CurDrive() + ":\" + CurDir() + "\" + AllTrim( cDbfName ) ) )

   ACTIVATE DIALOG oDlg CENTERED

return nil

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

function AddField( aFields, cFieldName, cType, nLen, nDec, oGet, oBrw )

   if Empty( cFieldName )
      oGet:SetPos( 0 )
      return nil
   endif   

   if Len( aFields ) == 1 .and. Empty( aFields[ 1 ][ 1 ] )
      aFields = { { cFieldName, Upper( Left( cType, 1 ) ), nLen, nDec } }
   else   
      AAdd( aFields, { cFieldName, Upper( Left( cType, 1 ) ), nLen, nDec } )
   endif
      
   oBrw:SetArray( aFields )
   oGet:VarPut( cFieldName := Space( 10 ) )
   oGet:SetPos( 0 )
   oGet:SetFocus()
   oBrw:GoBottom()
               
return nil

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

function OrdTagsCount()

   local n, nCount := 0
   
   for n = 1 to 100
      if ! Empty( OrdName( n ) )
         nCount++
      endif   
   next
   
return nCount   
   
//----------------------------------------------------------------------------//  

#pragma BEGINDUMP

#include <hbapi.h>
#include <hbapirdd.h>

HB_FUNC( ORDCONDGET )
{
   AREAP pArea = ( AREAP ) hb_rddGetCurrentWorkAreaPointer();
   
   if( pArea )
   {
      LPDBORDERCONDINFO lpdbOrdCondInfo = pArea->lpdbOrdCondInfo;
      
      if( lpdbOrdCondInfo && lpdbOrdCondInfo->abWhile )
         hb_retc( lpdbOrdCondInfo->abWhile );
      else
         hb_retc( "" );   
   }
   else
      hb_retc( "" );     
}

#pragma ENDDUMP

//----------------------------------------------------------------------------//  
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
ukoenig
Posts: 3981
Joined: Wed Dec 19, 2007 6:40 pm
Location: Germany
Contact:

Re: FiveDBU for 32/64 bits

Post by ukoenig »

Antonio,

does it make sense ?
Adding a Image-info to a field, You can preview this file.
It is just a start, but works fine.

Image

Best Regards
Uwe :lol:
Since 1995 ( the first release of FW 1.9 )
i work with FW.
If you have any questions about special functions, maybe i can help.
User avatar
Otto
Posts: 4470
Joined: Fri Oct 07, 2005 7:07 pm
Contact:

Re: FiveDBU for 32/64 bits

Post by Otto »

Hello Antonio,

On my 2008 R2 I have to command ON PAINT.
Best regards,
Otto

ACTIVATE WINDOW oWndMain MAXIMIZED ;
VALID MsgYesNo( "Want to end ?" ) //;
// ON PAINT DrawTiled( hDC, oWndMain, oBmpTiled )
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org

********************************************************************
User avatar
Otto
Posts: 4470
Joined: Fri Oct 07, 2005 7:07 pm
Contact:

Re: FiveDBU for 32/64 bits

Post by Otto »

Hello Antonio,

Would you please insert field - info on "click on header" like in xWDBU.

Best regards,
Otto
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org

********************************************************************
User avatar
Otto
Posts: 4470
Joined: Fri Oct 07, 2005 7:07 pm
Contact:

Re: FiveDBU for 32/64 bits

Post by Otto »

Hello Antonio,
where can I download the bitmaps.

Thanks in advance
Otto

pplication
===========
Path and name: C:\fwh\samples\fivedbu.exe (32 bits)
Size: 2,192,384 bytes
Compiler version: xHarbour build 1.2.1 Intl. (SimpLex) (Rev. 6715)
FiveWin Version: FWHX 12.03
Windows version: 6.1, Build 7601 Service Pack 1

Time from start: 0 hours 4 mins 7 secs
Error occurred at: 04/06/2012, 09:54:37
Error description: Warning BASE/1004 Message not found: TMSGITEM:SETBITMAP

Stack Calls
===========
Called from: source\rtl\tobject.prg => TMSGITEM:ERROR( 172 )
Called from: source\rtl\tobject.prg => TMSGITEM:MSGNOTFOUND( 205 )
Called from: source\rtl\tobject.prg => TMSGITEM:SETBITMAP( 0 )
Called from: C:\fwh\samples\fivedbu.prg => (b)OPEN( 176 )
Called from: => EVAL( 0 )
Called from: C:\fwh\samples\fivedbu.prg => (b)OPEN( 115 )
Called from: .\source\classes\MENU.PRG => TMENU:ACTIVATE( 494 )
Called from: .\source\classes\BTNBMP.PRG => TBTNBMP:LBUTTONUP( 646 )
Called from: .\source\classes\CONTROL.PRG => TCONTROL:HANDLEEVENT( 1690 )
Called from: .\source\classes\BTNBMP.PRG => TBTNBMP:HANDLEEVENT( 1408 )
Called from: .\source\classes\WINDOW.PRG => _FWH( 3153 )
Called from: => WINRUN( 0 )
Called from: .\source\classes\WINDOW.PRG => TMDIFRAME:ACTIVATE( 980 )
Called from: C:\fwh\samples\fivedbu.prg => MAIN( 39 )




********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org

********************************************************************
User avatar
ukoenig
Posts: 3981
Joined: Wed Dec 19, 2007 6:40 pm
Location: Germany
Contact:

Re: FiveDBU for 32/64 bits

Post by ukoenig »

Otto,

I created a complete new Image-set.
These Images are saved as 24 Bit with NO Alphachannel ( still shows a transparent-effect ).
That makes it possible, to save / use them from Resources.
I can add the Download-link, if needed.

Image

Best Regards
Uwe :lol: :?:
Last edited by ukoenig on Mon Jun 04, 2012 11:51 am, edited 1 time in total.
Since 1995 ( the first release of FW 1.9 )
i work with FW.
If you have any questions about special functions, maybe i can help.
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: FiveDBU for 32/64 bits

Post by Antonio Linares »

Uwe,

Very nice bitmaps! :-)

Where to download them from ? :-)

Thanks!
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Re: FiveDBU for 32/64 bits

Post by Antonio Linares »

Otto,

What would be better, to show the field info or to automatic index / sort on that field ?
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Otto
Posts: 4470
Joined: Fri Oct 07, 2005 7:07 pm
Contact:

Re: FiveDBU for 32/64 bits

Post by Otto »

Hello Antonio,

for everyday work the index would be better. Maybe you can show the field info on right click on header.

Best regards,
Otto
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org

********************************************************************
Post Reply