FiveTech Software tech support forums

www.FiveTechSoft.com
https://forums.fivetechsupport.com/

FiveDBU para 32/64 bits

https://forums.fivetechsupport.com/viewtopic.php?f=6&t=24180

Page 3 of 7

Re: FiveDBU para 32/64 bits

PostPosted: Thu May 31, 2012 10:32 pm
by Antonio Linares
Funcionando en Windows 7 correctamente

Re: FiveDBU para 32/64 bits

PostPosted: Thu May 31, 2012 11:06 pm
by Armando
Antonio:

Quieres que decir que no hay problema con W7?, lo que significa que mi PC tiene "algo"?
Podrías enviarme tu .EXE para probarlo en mi PC?

Saludos

Re: FiveDBU para 32/64 bits

PostPosted: Fri Jun 01, 2012 9:04 am
by José Vicente Beltrán
Hola a todos
En Win 7 professional 64bits funciona correcto

saludos :shock:

Re: FiveDBU para 32/64 bits

PostPosted: Fri Jun 01, 2012 11:34 am
by Antonio Linares
Armando,

Aqui está:

FIveDBU (EXE y código fuente incluidos)
http://code.google.com/p/fivewin-contributions/downloads/detail?name=fivedbu.zip&can=2&q=

Re: FiveDBU para 32/64 bits

PostPosted: Fri Jun 01, 2012 12:28 pm
by Antonio Linares
Soporte de MRU para los ficheros usados y edición de tipos automática en Edit

Image

Code: Select all  Expand view
#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

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

Re: FiveDBU para 32/64 bits

PostPosted: Fri Jun 01, 2012 1:11 pm
by Antonio Linares
Edición automática para campos Memo:

Image

Code: Select all  Expand view
#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

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

Re: FiveDBU para 32/64 bits

PostPosted: Fri Jun 01, 2012 1:23 pm
by Antonio Linares
Añadido bloqueo automático de registros:

Code: Select all  Expand view
#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

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

Re: FiveDBU para 32/64 bits

PostPosted: Fri Jun 01, 2012 2:33 pm
by Armando
Antonio:

Solo para tu información, el problema de la doble barra de botones persiste aún con tu .EXE
por lo que debo suponer que el problema esta de mi lado. Ojalá alguien me pueda aclarar el
problema.

Saludos

Re: FiveDBU para 32/64 bits

PostPosted: Fri Jun 01, 2012 3:55 pm
by jcenteno
Antonio,

Se podría abrir un fichero que está siendo utilizado por otra aplicación en modo exclusivo? así como hace visual foxpro con SET EXCLUSIVE OFF

Saludos.

Re: FiveDBU para 32/64 bits

PostPosted: Fri Jun 01, 2012 4:51 pm
by Antonio Linares
Armando,

Debe ser algo relacionado con video, por eso pensé en los drivers de video, ó en la velocidad del ordenador.

A ti ocurre algo semejante con otras aplicaciones ? Prueba con un PRG muy simple en el que solo tengas la ventana y la barra de botones.

Tal vez si no dibujas el BMP de fondo se solucione. Pruébalo

Re: FiveDBU para 32/64 bits

PostPosted: Fri Jun 01, 2012 5:57 pm
by sysctrl2
Hola Antonio,

al borrar un registro de la DBF en uso, marca error,

falta hacer dbrlock(), dbunlock()

tambien estaria bien que funcione como el viejo DBU.EXE

con la tecla supprimir borra y recupera.

Code: Select all  Expand view
function DelRecord( oBrw )
   IF ! (oBrw:cAlias)->( deleted() )
      ( oBrw:cAlias )->( DbRLock()   )  
      ( oBrw:cAlias )->( DbDelete()  )  
      ( oBrw:cAlias )->( DbUnlock()  )  
   ELSE
      ( oBrw:cAlias )->( DbRLock()   )  
      ( oBrw:cAlias )->( DbRecall()  )  
      ( oBrw:cAlias )->( DbUnlock()  )        
   endif
   oBrw:Refresh()
return nil


SALUDOS.

Re: FiveDBU para 32/64 bits

PostPosted: Fri Jun 01, 2012 8:16 pm
by Bayron
Armando wrote:Antonio:

Solo para tu información, el problema de la doble barra de botones persiste aún con tu .EXE
por lo que debo suponer que el problema esta de mi lado. Ojalá alguien me pueda aclarar el
problema.

Saludos


Muy extraño, intenta actualizar los driver de la tarjeta de video o al menos a desabilitarlos para que Windows los reconozca nuevamente...

Re: FiveDBU para 32/64 bits

PostPosted: Fri Jun 01, 2012 8:37 pm
by horacio
He bajado el último código y me pasa lo mismo que Armando pero ni siquiera se llegan a pintar las barras. Solo se ve dos rectángulos. Hasta ahora no he tenido ningún problema con mis aplicaciones. Un raro comportamiento.
Saludos

Re: FiveDBU para 32/64 bits

PostPosted: Fri Jun 01, 2012 10:46 pm
by sysctrl2
hola Armando, prueba comentando estas lineas.

Code: Select all  Expand view
ACTIVATE WINDOW oWndMain MAXIMIZED ;
      VALID MsgYesNo( "Want to end ?" )  //;
    //  ON PAINT DrawTiled( hDC, oWndMain, oBmpTiled )


saludos.

Re: FiveDBU para 32/64 bits

PostPosted: Sat Jun 02, 2012 1:42 am
by Armando
César:

Nop, no hay de piña !.

Saludos
All times are UTC
Page 3 of 7
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/