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 »

Michel,
driessen wrote:Antonio,

I tested your fivedbu and I really must congratulate you. Great job.

A few remarks, if I may :

1. The number of indexes in a CDX-files : it looks to me that there is a limit of 15 indexes. Is that correct ? Can the number of indexes be extended ?
2. How can I order my file with "Natural order" ?
3. An error occurs when I open a file, then close the file and then I try to open the file again.
4. Deleting a record doesn't seem to work.

Thanks for a great utility.
Thanks for your kind words :-)

1. As far as I know there is a limit of 15 tags for a CDX file. I may be wrong or it may have been increased but I don't know it.

2. Implemented "Natural order" selection from the "Index" popup menu in the new build that I just published.

3. Going to review it.

4. Going to review it.
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 »

Michel,

A revised version that allows to open/close and open again a DBF and also to open a DBF as many times as needed

fivedbu.prg

Code: Select all

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

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

REQUEST DBFCDX

static oWndMain, aSearches := {}

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

function Main()

   local oBar, oBmpTiled

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

   DEFINE BITMAP oBmpTiled FILENAME "..\bitmaps\backgrnd\iosbg.bmp"

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

   DEFINE BUTTONBAR oBar OF oWndMain 2010 SIZE 70, 70
   
   DEFINE BUTTON OF oBar PROMPT "New" FILENAME "../bitmaps/32x32/new.bmp" ;
      ACTION New()

   DEFINE BUTTON OF oBar PROMPT "Open" FILENAME "../bitmaps/32x32/open.bmp" ACTION Open()

   DEFINE BUTTON OF oBar PROMPT "Prev" FILENAME "../bitmaps/32x32/prev.bmp" ;
      ACTION oWndMain:PrevWindow() GROUP WHEN Len( oWndMain:oWndClient:aWnd ) > 1

   DEFINE BUTTON OF oBar PROMPT "Next" FILENAME "../bitmaps/32x32/next.bmp" ;
      ACTION oWndMain:NextWindow() WHEN Len( oWndMain:oWndClient:aWnd ) > 1

   DEFINE BUTTON OF oBar PROMPT "Exit" FILENAME "../bitmaps/32x32/exit.bmp" ;
      ACTION oWndMain:End() GROUP

   DEFINE MSGBAR PROMPT "FiveDBU 32/64 bits" 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 "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 ! "." $ cFileName
      cFileName += ".dbf"
   endif   
   
   if ! File( cFileName )
      if ! Empty( cFileName )
         MsgStop( "File not found: " + cFileName )
      endif   
      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        
   
   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 ) )
            endif   
            MENUITEM OrdName( n ) ;
               ACTION ( ( cAlias )->( DbSetOrder( oMenuItem:cPrompt ) ),;
                        oBrw:Refresh(), 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" FILENAME "../bitmaps/32x32/plus.bmp" ;
      ACTION ( ( oBrw:cAlias )->( DbAppend() ), oBrw:Refresh(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Edit" FILENAME "../bitmaps/32x32/edit.bmp" ;
      ACTION ( oBrw:cAlias )->( Edit() )

   DEFINE BUTTON OF oBar PROMPT "Del" FILENAME "../bitmaps/32x32/minus.bmp" ;
      ACTION If( MsgYesNo( "Want to delete this record ?" ),;
                ( ( oBrw:cAlias )->( DbDelete() ), oBrw:Refresh() ),)

   DEFINE BUTTON OF oBar PROMPT "Search" FILENAME "../bitmaps/32x32/search.bmp" ;
      GROUP ACTION ( cAlias )->( Search( oBrw ) )

   DEFINE BUTTON OF oBar PROMPT "Index" FILENAME "../bitmaps/32x32/index.bmp" ;
      MENU oPopup ACTION ( cAlias )->( Indexes() )

   DEFINE BUTTON OF oBar PROMPT "Top" FILENAME "../bitmaps/32x32/prev.bmp" ;
      ACTION ( oBrw:GoTop(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Bottom" FILENAME "../bitmaps/32x32/next.bmp" ;
      ACTION ( oBrw:GoBottom(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Struct" FILENAME "../bitmaps/32x32/setup.bmp" ;
      ACTION ( oBrw:cAlias )->( Struct() ) GROUP

   DEFINE BUTTON OF oBar PROMPT "Report" FILENAME "../bitmaps/32x32/print.bmp" ;
      ACTION oBrw:Report()

   DEFINE BUTTON OF oBar PROMPT "Exit" FILENAME "../bitmaps/32x32/exit.bmp" ACTION oWnd:End() GROUP

   @ 0, 0 XBROWSE oBrw OF oWnd LINES ;
      ON CHANGE oMsgBar:SetText( "Alias: " + Alias() + ;
                                 " RecNo: " + AllTrim( Str( RecNo() ) ) + "/" + ;
                                 AllTrim( Str( RecCount() ) ) )

   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() ) ) 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" FILENAME "../bitmaps/32x32/floppy.bmp" ;
      ACTION ( ( cAlias )->( SaveRecord( aRecord, nRecNo ) ), oBtnSave:Disable() )

   oBtnSave:Disable()

   DEFINE BUTTON OF oBar PROMPT "Prev" FILENAME "../bitmaps/32x32/prev.bmp" ;
      ACTION ( ( cAlias )->( DbSkip( -1 ) ),;
               oBrw:SetArray( aRecord := ( cAlias )->( LoadRecord() ) ),;
               oBrw:SetFocus(), Eval( oBrw:bChange ) ) GROUP

   DEFINE BUTTON OF oBar PROMPT "Next" FILENAME "../bitmaps/32x32/next.bmp" ;
      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" FILENAME "../bitmaps/32x32/exit.bmp" ;
      ACTION oWnd:End() GROUP

   @ 0, 0 XBROWSE oBrw OF oWnd ARRAY aRecord AUTOCOLS LINES ;
      HEADERS "FieldName", "Value" COLSIZES 150, 400 FASTEDIT ;
      ON CHANGE ( 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: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 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" FILENAME "../bitmaps/32x32/plus.bmp" ;
      ACTION ( MsgInfo( "Add Tag" ), oBrw:Refresh(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Edit" FILENAME "../bitmaps/32x32/edit.bmp" ;
      ACTION ( MsgInfo( "Edit" ) )

   DEFINE BUTTON OF oBar PROMPT "Del" FILENAME "../bitmaps/32x32/minus.bmp" ;
      ACTION If( MsgYesNo( "Want to delete this tag ?" ),;
                ( ( cAlias )->( OrdBagClear( oBrw:nArrayAt ) ), oBrw:Refresh() ),)
   
   DEFINE BUTTON OF oBar PROMPT "Exit" FILENAME "../bitmaps/32x32/exit.bmp" ;
      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 ), cValToChar( 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, cType

   ( Alias() )->( DbGoTo( nRecNo ) )
   
   for n = 1 to Len( aRecord )
       cType = ( Alias() )->( FieldType( n ) )
       
       do case
          case cType $ "C,M"
               ( Alias() )->( FieldPut( n, aRecord[ n ][ 2 ] ) )
              
          case cType == "N"
               ( Alias() )->( FieldPut( n, Val( aRecord[ n ][ 2 ] ) ) )

          case cType == "D"
               ( Alias() )->( FieldPut( n, CToD( aRecord[ n ][ 2 ] ) ) )

          case cType == "L"
               ( Alias() )->( FieldPut( n, Upper( AllTrim( aRecord[ n ][ 2 ] ) ) == ".T." ) )
       endcase        
   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" FILENAME "../bitmaps/32x32/source.bmp" ;
      ACTION ( TxtStruct(), oBrw:SetFocus() )

   DEFINE BUTTON OF oBar PROMPT "Exit" FILENAME "../bitmaps/32x32/exit.bmp" ;
      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" } ;
      OF oDlg

   @ 1.4, 11.9 GET nLen PICTURE "999" OF oDlg SIZE 25, 11

   @ 1.4, 15.4 GET nDec PICTURE "999" OF oDlg SIZE 25, 11

   @ 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( cDbfName, aFields ),), oDlg:End(),;
          Open( hb_CurDrive() + ":\" + CurDir() + "\" + 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 »

Image
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Bayron
Posts: 815
Joined: Thu Dec 24, 2009 12:46 am
Location: Philadelphia, PA

Re: FiveDBU for 32/64 bits

Post by Bayron »

Nice!!!
Keep up the good work...!!!
=====>

Bayron Landaverry
(215)2226600 Philadelphia,PA, USA
+(502)46727275 Guatemala
MayaBuilders@gMail.com

FWH12.04||Harbour 3.2.0 (18754)||BCC6.5||UEstudio 10.10||
Windows 7 Ultimate

FiveWin, One line of code and it's done...
User avatar
driessen
Posts: 1239
Joined: Mon Oct 10, 2005 11:26 am
Location: Genk, Belgium

Re: FiveDBU for 32/64 bits

Post by driessen »

Antonio,

As far as I know there is no limit to CDX indexes.
I have some files with more than 50 indexes without any problem, all working jus fine.

Thanks for all your work.
Regards,

Michel D.
Genk (Belgium)
_____________________________________________________________________________________________
I use : FiveWin for (x)Harbour v. 21.01 - Harbour 3.2.0 (October 2020) - xHarbour Builder (January 2020) - Bcc7
User avatar
driessen
Posts: 1239
Joined: Mon Oct 10, 2005 11:26 am
Location: Genk, Belgium

Re: FiveDBU for 32/64 bits

Post by driessen »

Antonio,

First of all, concerning the number of indexes, I tried to change your source

Code: Select all

for n=1 to 15
into

Code: Select all

for n=1 to 100
Now I got all my indexes and everything is working just fine.

Maybe another suggestion concerning the date.

I noticed that you use MM/DD/YYYY format. Could we have a choice to change to DD/MM/YYYY since this is the used format in Belgium and the Netherlands?

Thanks a lot in advance.
Regards,

Michel D.
Genk (Belgium)
_____________________________________________________________________________________________
I use : FiveWin for (x)Harbour v. 21.01 - Harbour 3.2.0 (October 2020) - xHarbour Builder (January 2020) - Bcc7
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 »

Michel,

You are right, surely I was thinking about NTX or relations and had that number in my mind :-)

Going to change the date format, thanks
regards, saludos

Antonio Linares
www.fivetechsoft.com
StefanHaupt
Posts: 824
Joined: Thu Oct 13, 2005 7:39 am
Location: Germany

Re: FiveDBU for 32/64 bits

Post by StefanHaupt »

Antonio,

really great job :D
PROMPT "Exit" FILENAME "../bitmaps/32x32/exit.bmp" ;
Is there a special reason, why you are using slashes instead opf backslashes ? I wasn´t aware that this is possible in windows.
kind regards
Stefan
StefanHaupt
Posts: 824
Joined: Thu Oct 13, 2005 7:39 am
Location: Germany

Re: FiveDBU for 32/64 bits

Post by StefanHaupt »

small bugfix creating the dbf to trim the filename

Code: Select all

@ 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() + "\" + cDbfName ) )
kind regards
Stefan
User avatar
driessen
Posts: 1239
Joined: Mon Oct 10, 2005 11:26 am
Location: Genk, Belgium

Re: FiveDBU for 32/64 bits

Post by driessen »

Antonio,

I am going to send you an email with a file DBQ.ZIP. This is a fantastic DBF-manager for CDXRDD.
Only problem : it is still written for a DOS environment and 16-bits.

But it might give you a excellent idea for all the needed funtionalities. If possible, I still use it because it is so easy.

If you have any questions about DBQ, don't hesitate to mail me.

Good luck.
Regards,

Michel D.
Genk (Belgium)
_____________________________________________________________________________________________
I use : FiveWin for (x)Harbour v. 21.01 - Harbour 3.2.0 (October 2020) - xHarbour Builder (January 2020) - Bcc7
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,

Yes, Windows allows the use of slashes too, I am used to such format as it is also the one used in Mac OSX and Linux :-)

Thanks for the bug fix and for your kind words
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 »

Michel,

Thanks for your feedback, I will review it :-)
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 »

FiveDBU available from here (source code and EXE 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 »

MRU support for used files and auto type detection in Edit

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 =="D"
           oBrw:aCols[ 2 ]:nEditType = EDIT_BUTTON
           oBrw:aCols[ 2 ]:bEditBlock = { || If( ! Empty( CToD( 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 ), cValToChar( 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, cType

   ( Alias() )->( DbGoTo( nRecNo ) )
   
   for n = 1 to Len( aRecord )
       cType = ( Alias() )->( FieldType( n ) )
       
       do case
          case cType $ "C,M"
               ( Alias() )->( FieldPut( n, aRecord[ n ][ 2 ] ) )
              
          case cType == "N"
               ( Alias() )->( FieldPut( n, Val( aRecord[ n ][ 2 ] ) ) )

          case cType == "D"
               ( Alias() )->( FieldPut( n, CToD( aRecord[ n ][ 2 ] ) ) )

          case cType == "L"
               ( Alias() )->( FieldPut( n, Upper( AllTrim( aRecord[ n ][ 2 ] ) ) == ".T." ) )
       endcase        
   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" } ;
      OF oDlg

   @ 1.4, 11.9 GET nLen PICTURE "999" OF oDlg SIZE 25, 11

   @ 1.4, 15.4 GET nDec PICTURE "999" OF oDlg SIZE 25, 11

   @ 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() + "\" + 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
StefanHaupt
Posts: 824
Joined: Thu Oct 13, 2005 7:39 am
Location: Germany

Re: FiveDBU for 32/64 bits

Post by StefanHaupt »

I forgot the second Dbfname :wink:

Code: Select all

@ 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) ) )
I added the possibility to create memo fields and set default values dependent of the fieldtype

Code: Select all

@ 1.3, 6.5 COMBOBOX cType ITEMS { "Character", "Number", "Date", "Logical", "Memo" } ;
          OF oDlg ON CHANGE (IIF(cType = "Character", (nLen := 10, nDec := 0),),;
                             IIF(cType = "Number", nDec := 0,),;
                             IIF(cType = "Date", (nLen:= 8, nDec := 0),),;
                             IIF(cType = "Logical", (nLen := 1, nDec := 0),),;
                             IIF(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
kind regards
Stefan
Post Reply