Many thanks for your help!
FiveTech Software tech support forums
www.FiveTechSoft.com
FiveDBU for 32/64 bits
Re: FiveDBU for 32/64 bits
by Antonio Linares » Fri Jun 01, 2012 1:09 pm
Stefan,
Many thanks for your help!
Many thanks for your help!
-
Antonio Linares - Site Admin
- Posts: 42089
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
Re: FiveDBU for 32/64 bits
by Antonio Linares » Fri Jun 01, 2012 1:10 pm
Automatic editing for Memo fields:
- 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
//----------------------------------------------------------------------------//
-
Antonio Linares - Site Admin
- Posts: 42089
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
Re: FiveDBU for 32/64 bits
by Antonio Linares » Fri Jun 01, 2012 1:23 pm
Added automatic records lock when saving:
- 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
//----------------------------------------------------------------------------//
-
Antonio Linares - Site Admin
- Posts: 42089
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
Re: FiveDBU for 32/64 bits
by TimStone » Fri Jun 01, 2012 2:39 pm
Antonio,
I imagine you will be "going there" but the utility will also need full search and replace capabilities.
Also, filters .
I was able to build and test a recent version ... MSVC with Harbour ... but I was missing a few bmps.
Tim
I imagine you will be "going there" but the utility will also need full search and replace capabilities.
Also, filters .
I was able to build and test a recent version ... MSVC with Harbour ... but I was missing a few bmps.
Tim
Tim Stone
http://www.MasterLinkSoftware.com
http://www.autoshopwriter.com
timstone@masterlinksoftware.com
Using: FWH 23.10 with Harbour 3.2.0 / Microsoft Visual Studio Community 2022-24 32/64 bit
http://www.MasterLinkSoftware.com
http://www.autoshopwriter.com
timstone@masterlinksoftware.com
Using: FWH 23.10 with Harbour 3.2.0 / Microsoft Visual Studio Community 2022-24 32/64 bit
-
TimStone - Posts: 2944
- Joined: Fri Oct 07, 2005 1:45 pm
- Location: Trabuco Canyon, CA USA
Re: FiveDBU for 32/64 bits
by Antonio Linares » Sun Jun 03, 2012 11:02 am
DELETE msg for Deleted records also a different text color
- 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, cClrBack
DEFAULT cFileName := cGetFile( "*.dbf", "Please select a DBF" )
if Empty( cFileName )
return nil
endif
if ! "." $ cFileName
cFileName += ".dbf"
endif
if ! File( cFileName )
MsgStop( "File not found: " + cFileName )
return nil
endif
if File( cFileNoExt( cFileName ) + ".ntx" )
USE ( cFileName ) VIA "DBFNTX" NEW SHARED ;
ALIAS ( cGetNewAlias( cFileName( cFileNoExt( cFileName ) ) ) )
else
USE ( cFileName ) VIA "DBFCDX" NEW SHARED ;
ALIAS ( cGetNewAlias( cFileName( cFileNoExt( cFileName ) ) ) )
cAlias = Alias()
endif
oMruDBFs:Save( cFileName )
MENU oPopup POPUP
MENUITEM "Natural order" ;
ACTION ( ( cAlias )->( DbSetOrder( 0 ) ), oBrw:Refresh(), oBrw:SetFocus() )
SEPARATOR
for n = 1 to 15
if ! Empty( OrdName( n ) )
if ! Empty( OrdName( 1 ) )
DbSetOrder( OrdName( 1 ) )
DbGoTop()
endif
MENUITEM OrdName( n ) ;
ACTION ( ( cAlias )->( DbSetOrder( oMenuItem:cPrompt ) ),;
oBrw:Refresh(), Eval( oBrw:bChange ), oBrw:SetFocus() )
endif
next
ENDMENU
DEFINE WINDOW oWnd TITLE "Browse " + cFileName MDICHILD
DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70
DEFINE BUTTON OF oBar PROMPT "Add" RESOURCE "add" ;
ACTION ( ( oBrw:cAlias )->( DbAppend() ), oBrw:Refresh(), oBrw:SetFocus() )
DEFINE BUTTON OF oBar PROMPT "Edit" RESOURCE "edit" ;
ACTION ( oBrw:cAlias )->( Edit() )
DEFINE BUTTON OF oBar PROMPT "Del" RESOURCE "del" ;
ACTION DelRecord( oBrw )
DEFINE BUTTON OF oBar PROMPT "Search" RESOURCE "search" ;
GROUP ACTION ( cAlias )->( Search( oBrw ) )
DEFINE BUTTON OF oBar PROMPT "Index" RESOURCE "index" ;
MENU oPopup ACTION ( cAlias )->( Indexes() )
DEFINE BUTTON OF oBar PROMPT "Top" RESOURCE "prev" ;
ACTION ( oBrw:GoTop(), oBrw:SetFocus() )
DEFINE BUTTON OF oBar PROMPT "Bottom" RESOURCE "next" ;
ACTION ( oBrw:GoBottom(), oBrw:SetFocus() )
DEFINE BUTTON OF oBar PROMPT "Struct" RESOURCE "struct" ;
ACTION ( oBrw:cAlias )->( Struct() ) GROUP
DEFINE BUTTON OF oBar PROMPT "Report" RESOURCE "report" ;
ACTION oBrw:Report()
DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ACTION oWnd:End() GROUP
@ 0, 0 XBROWSE oBrw OF oWnd LINES ;
ON CHANGE ( oMsgBar:cMsgDef := "Alias: " + Alias() + ;
" RecNo: " + AllTrim( Str( RecNo() ) ) + "/" + ;
AllTrim( Str( RecCount() ) ) + ;
" Ordered by: " + OrdName() + ;
If( ( oBrw:cAlias )->( Deleted() ), "DELETED", "" ),;
oMsgBar:Refresh() )
oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW
oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
{ If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, CLR_BLACK ),;
RGB( 198, 255, 198 ) }, ;
{ If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, CLR_BLACK ),;
RGB( 232, 255, 232 ) } ) }
oBrw:bClrSel = { || { If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, CLR_WHITE ),;
RGB( 0x33, 0x66, 0xCC ) } }
cClrBack = Eval( oBrw:bClrSelFocus )[ 2 ]
oBrw:bClrSelFocus = { || { If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, CLR_WHITE ),;
cClrBack } }
oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
oBrw:CreateFromCode()
oBrw:SetFocus()
oBrw:bLDblClick = { || ( oBrw:cAlias )->( Edit() ) }
oWnd:oClient = oBrw
DEFINE MSGBAR oMsgBar PROMPT "Alias: " + Alias() + " RecNo: " + ;
AllTrim( Str( RecNo() ) ) + "/" + ;
AllTrim( Str( RecCount() ) ) + ;
" Ordered by: " + OrdName() + ;
If( ( oBrw:cAlias )->( Deleted() ), "DELETED", "" ) ;
OF oWnd 2010
ACTIVATE WINDOW oWnd ;
VALID ( ( cAlias )->( DbCloseArea() ), oBrw:cAlias := "", .T. )
return nil
//----------------------------------------------------------------------------//
function DelRecord( oBrw )
if ! ( oBrw:cAlias )->( Deleted() )
if ! MsgYesNo( "Want to delete this record ?" )
return nil
endif
( oBrw:cAlias )->( DbRLock() )
( oBrw:cAlias )->( DbDelete() )
( oBrw:cAlias )->( DbUnlock() )
else
( oBrw:cAlias )->( DbRLock() )
( oBrw:cAlias )->( DbRecall() )
( oBrw:cAlias )->( DbUnlock() )
MsgInfo( "UnDeleted record" )
endif
Eval( oBrw:bChange )
oBrw:Refresh()
return nil
//----------------------------------------------------------------------------//
function Edit()
local oWnd, aRecord := ( Alias() )->( LoadRecord() ), oBar, oBrw, oMsgBar
local cAlias := Alias(), oBtnSave, nRecNo := ( Alias() )->( RecNo() )
DEFINE WINDOW oWnd TITLE "Edit " + Alias() MDICHILD
oWndMain:oBar:AEvalWhen()
DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70
DEFINE BUTTON oBtnSave OF oBar PROMPT "Save" RESOURCE "save" ;
ACTION ( ( cAlias )->( SaveRecord( aRecord, nRecNo ) ), oBtnSave:Disable() )
oBtnSave:Disable()
DEFINE BUTTON OF oBar PROMPT "Prev" RESOURCE "prev" ;
ACTION ( ( cAlias )->( DbSkip( -1 ) ),;
oBrw:SetArray( aRecord := ( cAlias )->( LoadRecord() ) ),;
oBrw:SetFocus(), Eval( oBrw:bChange ) ) GROUP
DEFINE BUTTON OF oBar PROMPT "Next" RESOURCE "next" ;
ACTION ( ( cAlias )->( DbSkip( 1 ) ),;
If( ( cAlias )->( Eof() ), ( cAlias )->( DbSkip( -1 ) ),),;
oBrw:SetArray( aRecord := ( cAlias )->( LoadRecord() ) ),;
oBrw:SetFocus(), Eval( oBrw:bChange ) ) GROUP
DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
ACTION oWnd:End() GROUP
@ 0, 0 XBROWSE oBrw OF oWnd ARRAY aRecord AUTOCOLS LINES ;
HEADERS "FieldName", "Value" COLSIZES 150, 400 FASTEDIT ;
ON CHANGE ( ( cAlias )->( SetEditType( oBrw, oBtnSave ) ),;
oMsgBar:cMsgDef := " RecNo: " + AllTrim( Str( ( cAlias )->( RecNo() ) ) ) + ;
"/" + AllTrim( Str( ( cAlias )->( RecCount() ) ) ),;
oMsgBar:Refresh() )
oBrw:nEditTypes = EDIT_GET
oBrw:aCols[ 1 ]:nEditType = 0 // Don't allow to edit first column
oBrw:aCols[ 2 ]:bOnChange = { || oBtnSave:Enable() }
oBrw:aCols[ 2 ]:lWillShowABtn = .T.
oBrw:nMarqueeStyle = MARQSTYLE_HIGHLROW
oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
{ CLR_BLACK, RGB( 198, 255, 198 ) }, ;
{ CLR_BLACK, RGB( 232, 255, 232 ) } ) }
oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }
oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
oBrw:CreateFromCode()
oBrw:SetFocus()
oWnd:oClient = oBrw
DEFINE MSGBAR oMsgBar ;
PROMPT " RecNo: " + AllTrim( Str( ( cAlias )->( RecNo() ) ) ) + "/" + ;
AllTrim( Str( ( cAlias )->( RecCount() ) ) ) OF oWnd 2010
ACTIVATE WINDOW oWnd
return nil
//----------------------------------------------------------------------------//
function SetEditType( oBrw, oBtnSave )
local cType := FieldType( oBrw:nArrayAt )
do case
case cType == "M"
oBrw:aCols[ 2 ]:nEditType = EDIT_BUTTON
oBrw:aCols[ 2 ]:bEditBlock = { | c | c := oBrw:aRow[ 2 ],;
MemoEdit( @oBrw:aRow[ 2 ], FieldName( oBrw:nArrayAt ) ),;
If( ! c == oBrw:aRow[ 2 ], oBtnSave:Enable(),),;
oBrw:aRow[ 2 ] }
case cType == "D"
oBrw:aCols[ 2 ]:nEditType = EDIT_BUTTON
oBrw:aCols[ 2 ]:bEditBlock = { || If( ! Empty( oBrw:aRow[ 2 ] ) .and. ;
! AllTrim( oBrw:aRow[ 2 ] ) == "/ /",;
DToC( MsgDate( CtoD( oBrw:aRow[ 2 ] ) ) ),;
DToC( MsgDate( Date() ) ) ) }
case cType == "L"
oBrw:aCols[ 2 ]:nEditType = EDIT_LISTBOX
oBrw:aCols[ 2 ]:aEditListTxt = { ".T.", ".F." }
otherwise
oBrw:aCols[ 2 ]:nEditType = EDIT_GET
endcase
return nil
//----------------------------------------------------------------------------//
function IndexBuilder()
local oDlg, cKey := Space( 80 )
DEFINE DIALOG oDlg TITLE "Index builder" SIZE 600, 500
oDlg:lDesign = .T.
@ 0.5, 2 SAY "Index on" OF oDlg SIZE 40, 8
@ 1.4, 1 GET cKey OF oDlg SIZE 140, 11 ACTION ExpBuilder()
@ 0.5, 15 SAY "Tag" OF oDlg SIZE 40, 8
ACTIVATE DIALOG oDlg CENTERED
return nil
//----------------------------------------------------------------------------//
function Indexes()
local oWnd, oBar, oBrw, oMsgBar
local cAlias := Alias(), aIndexes := {}, n
for n = 1 to 15
if ! Empty( OrdName( n ) )
AAdd( aIndexes, { n,;
OrdName( n ),;
OrdKey( n ),;
OrdFor( n ),;
OrdBagName( n ),;
OrdBagExt( n ) } )
endif
next
DEFINE WINDOW oWnd TITLE "Indexes of " + Alias() MDICHILD
oWndMain:oBar:AEvalWhen()
DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70
DEFINE BUTTON OF oBar PROMPT "Add" RESOURCE "add" ;
ACTION ( MsgInfo( "Add Tag" ), oBrw:Refresh(), oBrw:SetFocus() )
DEFINE BUTTON OF oBar PROMPT "Edit" RESOURCE "edit" ;
ACTION ( MsgInfo( "Edit" ) )
DEFINE BUTTON OF oBar PROMPT "Del" RESOURCE "del" ;
ACTION If( MsgYesNo( "Want to delete this tag ?" ),;
( ( cAlias )->( OrdBagClear( oBrw:nArrayAt ) ), oBrw:Refresh() ),)
DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
ACTION oWnd:End() GROUP
@ 0, 0 XBROWSE oBrw OF oWnd ARRAY aIndexes AUTOCOLS LINES ;
HEADERS "Order", "TagName", "Expression", "For", "BagName", "BagExt" ;
COLSIZES 50, 150, 400, 400, 150, 150
oBrw:nMarqueeStyle = MARQSTYLE_HIGHLROW
oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
{ CLR_BLACK, RGB( 198, 255, 198 ) }, ;
{ CLR_BLACK, RGB( 232, 255, 232 ) } ) }
oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }
oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
oBrw:CreateFromCode()
oBrw:SetFocus()
oWnd:oClient = oBrw
DEFINE MSGBAR oMsgBar 2010
ACTIVATE WINDOW oWnd
return nil
//----------------------------------------------------------------------------//
function ExpBuilder()
local oDlg
DEFINE DIALOG oDlg TITLE "Expression builder"
ACTIVATE DIALOG oDlg CENTERED
return nil
//----------------------------------------------------------------------------//
function LoadRecord()
local aRecord := {}, n
for n = 1 to FCount()
AAdd( aRecord, { FieldName( n ), FieldGet( n ) } )
next
return aRecord
//----------------------------------------------------------------------------//
function Search( oBrw )
local oDlg, oCbx, cSearch := Space( 50 )
local nRecNo := RecNo(), lInc := .T.
DEFINE DIALOG oDlg TITLE "Search: " + Alias() SIZE 400, 200
@ 0.5, 1.5 SAY "Ordered by: " + OrdName() OF oDlg
@ 1.2, 1.5 SAY "Key: " + OrdKey() OF oDlg
@ 2.4, 1.2 COMBOBOX oCbx VAR cSearch ITEMS aSearches OF oDlg SIZE 180, 150 ;
STYLE CBS_DROPDOWN
oCbx:oGet:bChange = { || DbSeek( AllTrim( oCbx:GetText() ), lInc ), oBrw:Refresh() }
@ 3.7, 1.5 CHECKBOX lInc PROMPT "&Incremental" OF oDlg SIZE 80, 10
@ 4, 7 BUTTON "&Ok" OF oDlg SIZE 45, 13 ;
ACTION ( If( ! DbSeek( AllTrim( cSearch ), lInc ), DbGoTo( nRecNo ),),;
AAdd( aSearches, AllTrim( cSearch ) ), oDlg:End() )
@ 4, 18 BUTTON "&Cancel" OF oDlg SIZE 45, 13 ACTION oDlg:End()
ACTIVATE DIALOG oDlg CENTERED
return nil
//----------------------------------------------------------------------------//
function SaveRecord( aRecord, nRecNo )
local n
( Alias() )->( DbGoTo( nRecNo ) )
if ( Alias() )->( DbRLock( nRecNo ) )
for n = 1 to Len( aRecord )
( Alias() )->( FieldPut( n, aRecord[ n ][ 2 ] ) )
next
( Alias() )->( DbUnLock() )
MsgInfo( "Record updated" )
else
MsgAlert( "Record in use, please try it again" )
endif
return nil
//----------------------------------------------------------------------------//
function Struct()
local oDlg, oBrw, aFields := DbStruct()
DEFINE DIALOG oDlg TITLE Alias() + " fields" SIZE 400, 400
@ 0, 0 XBROWSE oBrw ARRAY aFields AUTOCOLS LINES ;
HEADERS "Name", "Type", "Len", "Dec" ;
COLSIZES 150, 50, 80, 80
oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW
oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
{ CLR_BLACK, RGB( 198, 255, 198 ) }, ;
{ CLR_BLACK, RGB( 232, 255, 232 ) } ) }
oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }
oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
oBrw:CreateFromCode()
oDlg:oClient = oBrw
ACTIVATE DIALOG oDlg CENTERED ;
ON INIT ( BuildStructBar( oDlg, oBrw ), oDlg:Resize(), oBrw:SetFocus() )
return nil
//----------------------------------------------------------------------------//
function BuildStructBar( oDlg, oBrw )
local oBar
DEFINE BUTTONBAR oBar OF oDlg 2010 SIZE 70, 70
DEFINE BUTTON OF oBar PROMPT "Code" RESOURCE "code" ;
ACTION ( TxtStruct(), oBrw:SetFocus() )
DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
ACTION oDlg:End() GROUP
return nil
//----------------------------------------------------------------------------//
function TxtStruct()
local cCode := "local aFields := { ", n
for n = 1 to FCount()
if n > 1
cCode += Space( 27 )
endif
cCode += '{ "' + FieldName( n ) + '", "' + ;
FieldType( n ) + '", ' + ;
AllTrim( Str( FieldLen( n ) ) ) + ", " + ;
AllTrim( Str( FieldDec( n ) ) ) + " },;" + CRLF
next
cCode = SubStr( cCode, 1, Len( cCode ) - 4 ) + " }"
MemoEdit( cCode, "Code" )
return nil
//----------------------------------------------------------------------------//
function New()
local oDlg, oGet, oBrw
local cFieldName := Space( 10 ), cType, nLen := 10, nDec := 0
local aFields := { Array( 4 ) }, cDbfName := Space( 8 ), aTemp
DEFINE DIALOG oDlg TITLE "DBF builder" SIZE 415, 400
@ 0.5, 2 SAY "Field Name" OF oDlg SIZE 40, 8
@ 0.5, 10 SAY "Type" OF oDlg SIZE 40, 8
@ 0.5, 17 SAY "Len" OF oDlg SIZE 40, 8
@ 0.5, 22 SAY "Dec" OF oDlg SIZE 20, 8
@ 1.4, 1 GET oGet VAR cFieldName PICTURE "!!!!!!!!!!" OF oDlg SIZE 41, 11
@ 1.3, 6.5 COMBOBOX cType ITEMS { "Character", "Number", "Date", "Logical", "Memo" } ;
OF oDlg ON CHANGE ( If( cType == "Character", ( nLen := 10, nDec := 0 ),),;
If( cType == "Number", nDec := 0,),;
If( cType == "Date", ( nLen := 8, nDec := 0 ),),;
If( cType == "Logical", ( nLen := 1, nDec := 0 ),),;
If( cType == "Memo", ( nLen := 10, nDec := 0 ),),;
oDlg:Update() )
@ 1.4, 11.9 GET nLen PICTURE "999" OF oDlg SIZE 25, 11 UPDATE
@ 1.4, 15.4 GET nDec PICTURE "999" OF oDlg SIZE 25, 11 WHEN cType = "Number" UPDATE
@ 0.9, 26 BUTTON "&Add" OF oDlg SIZE 45, 13 ;
ACTION AddField( @aFields, @cFieldName, @cType, @nLen, @nDec, oGet, oBrw )
@ 2.2, 2 SAY "Fields" OF oDlg SIZE 40, 8
@ 3.2, 1 XBROWSE oBrw ARRAY aFields AUTOCOLS ;
HEADERS "Name", "Type", "Len", "Dec" ;
COLSIZES 90, 55, 40, 40 ;
SIZE 140, 130 OF oDlg
oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW
oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
{ CLR_BLACK, RGB( 198, 255, 198 ) }, ;
{ CLR_BLACK, RGB( 232, 255, 232 ) } ) }
oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }
oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
oBrw:CreateFromCode()
@ 2.4, 26 BUTTON "&Edit" OF oDlg SIZE 45, 13
@ 3.4, 26 BUTTON "&Delete" OF oDlg SIZE 45, 13
@ 4.4, 26 BUTTON "Move &Up" OF oDlg SIZE 45, 13 ;
ACTION If( oBrw:nArrayAt > 1,;
( aTemp := aFields[ oBrw:nArrayAt ],;
aFields[ oBrw:nArrayAt ] := aFields[ oBrw:nArrayAt - 1 ],;
aFields[ oBrw:nArrayAt - 1 ] := aTemp,;
oBrw:GoUp() ),)
@ 5.4, 26 BUTTON "Move D&own" OF oDlg SIZE 45, 13 ;
ACTION If( oBrw:nArrayAt < Len( aFields ),;
( aTemp := aFields[ oBrw:nArrayAt ],;
aFields[ oBrw:nArrayAt ] := aFields[ oBrw:nArrayAt + 1 ],;
aFields[ oBrw:nArrayAt + 1 ] := aTemp,;
oBrw:GoDown() ),)
@ 12.1, 2 SAY "DBF Name:" OF oDlg SIZE 30, 8
@ 14, 6 GET cDbfName PICTURE "!!!!!!!!!!!!" OF oDlg SIZE 100, 11
@ 10, 26 BUTTON "&Create" OF oDlg SIZE 45, 13 ;
ACTION ( If( ! Empty( cDbfName ) .and. Len( aFields ) > 0,;
DbCreate( AllTrim( cDbfName ), aFields ),), oDlg:End(),;
Open( hb_CurDrive() + ":\" + CurDir() + "\" + AllTrim( cDbfName ) ) )
ACTIVATE DIALOG oDlg CENTERED
return nil
//----------------------------------------------------------------------------//
function AddField( aFields, cFieldName, cType, nLen, nDec, oGet, oBrw )
if Empty( cFieldName )
oGet:SetPos( 0 )
return nil
endif
if Len( aFields ) == 1 .and. Empty( aFields[ 1 ][ 1 ] )
aFields = { { cFieldName, Upper( Left( cType, 1 ) ), nLen, nDec } }
else
AAdd( aFields, { cFieldName, Upper( Left( cType, 1 ) ), nLen, nDec } )
endif
oBrw:SetArray( aFields )
oGet:VarPut( cFieldName := Space( 10 ) )
oGet:SetPos( 0 )
oGet:SetFocus()
oBrw:GoBottom()
return nil
//----------------------------------------------------------------------------//
#pragma BEGINDUMP
#include <hbapi.h>
#include <hbapirdd.h>
HB_FUNC( ORDCONDGET )
{
AREAP pArea = ( AREAP ) hb_rddGetCurrentWorkAreaPointer();
if( pArea )
{
LPDBORDERCONDINFO lpdbOrdCondInfo = pArea->lpdbOrdCondInfo;
if( lpdbOrdCondInfo && lpdbOrdCondInfo->abWhile )
hb_retc( lpdbOrdCondInfo->abWhile );
else
hb_retc( "" );
}
else
hb_retc( "" );
}
#pragma ENDDUMP
//----------------------------------------------------------------------------//
-
Antonio Linares - Site Admin
- Posts: 42089
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
Re: FiveDBU for 32/64 bits
by Antonio Linares » Sun Jun 03, 2012 12:12 pm
More recent version, full source code included:
http://code.google.com/p/fivewin-contributions/downloads/detail?name=fivedbu_20120603.zip&can=2&q=
http://code.google.com/p/fivewin-contributions/downloads/detail?name=fivedbu_20120603.zip&can=2&q=
-
Antonio Linares - Site Admin
- Posts: 42089
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
Re: FiveDBU for 32/64 bits
by Antonio Linares » Sun Jun 03, 2012 8:43 pm
Enhanced version:
- 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, oMsgDeleted, oMsgTagName
local oPopup, cAlias, n, cClrBack, nTags
DEFAULT cFileName := cGetFile( "*.dbf", "Please select a DBF" )
if Empty( cFileName )
return nil
endif
if ! "." $ cFileName
cFileName += ".dbf"
endif
if ! File( cFileName )
MsgStop( "File not found: " + cFileName )
return nil
endif
if File( cFileNoExt( cFileName ) + ".ntx" )
USE ( cFileName ) VIA "DBFNTX" NEW SHARED ;
ALIAS ( cGetNewAlias( cFileName( cFileNoExt( cFileName ) ) ) )
else
USE ( cFileName ) VIA "DBFCDX" NEW SHARED ;
ALIAS ( cGetNewAlias( cFileName( cFileNoExt( cFileName ) ) ) )
cAlias = Alias()
endif
oMruDBFs:Save( cFileName )
MENU oPopup POPUP
MENUITEM "Natural order" ;
ACTION ( ( cAlias )->( DbSetOrder( 0 ) ), oBrw:Refresh(), oBrw:SetFocus(),;
( cAlias )->( Eval( oBrw:bChange ) ) )
if ( nTags := ( cAlias )->( OrdTagsCount() ) ) > 0
SEPARATOR
endif
for n = 1 to nTags
if ! Empty( OrdName( n ) )
if ! Empty( OrdName( 1 ) )
DbSetOrder( OrdName( 1 ) )
DbGoTop()
endif
MENUITEM OrdName( n ) ;
ACTION ( ( cAlias )->( DbSetOrder( oMenuItem:cPrompt ) ),;
oBrw:Refresh(), ( cAlias )->( Eval( oBrw:bChange ) ), oBrw:SetFocus() )
endif
next
ENDMENU
DEFINE WINDOW oWnd TITLE "Browse " + cFileName MDICHILD
DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70
DEFINE BUTTON OF oBar PROMPT "Add" RESOURCE "add" ;
ACTION ( ( oBrw:cAlias )->( DbAppend() ), oBrw:Refresh(), oBrw:SetFocus() )
DEFINE BUTTON OF oBar PROMPT "Edit" RESOURCE "edit" ;
ACTION ( oBrw:cAlias )->( Edit() )
DEFINE BUTTON OF oBar PROMPT "Del" RESOURCE "del" ;
ACTION ( obrw:cAlias )->( DelRecord( oBrw ) )
DEFINE BUTTON OF oBar PROMPT "Search" RESOURCE "search" ;
GROUP ACTION ( cAlias )->( Search( oBrw ) )
DEFINE BUTTON OF oBar PROMPT "Index" RESOURCE "index" ;
MENU oPopup ACTION ( cAlias )->( Indexes() )
DEFINE BUTTON OF oBar PROMPT "Top" RESOURCE "prev" ;
ACTION ( oBrw:GoTop(), oBrw:SetFocus() )
DEFINE BUTTON OF oBar PROMPT "Bottom" RESOURCE "next" ;
ACTION ( oBrw:GoBottom(), oBrw:SetFocus() )
DEFINE BUTTON OF oBar PROMPT "Struct" RESOURCE "struct" ;
ACTION ( oBrw:cAlias )->( Struct() ) GROUP
DEFINE BUTTON OF oBar PROMPT "Report" RESOURCE "report" ;
ACTION oBrw:Report()
DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ACTION oWnd:End() GROUP
@ 0, 0 XBROWSE oBrw OF oWnd LINES ;
ON CHANGE ( oMsgBar:cMsgDef := "Alias: " + Alias() + ;
" RecNo: " + AllTrim( Str( RecNo() ) ) + "/" + ;
AllTrim( Str( RecCount() ) ),;
oMsgBar:Refresh(),;
oMsgTagName:SetText( "Ordered by: " + If( ! Empty( OrdName() ), OrdName(), "Natural order" ) ),;
oMsgDeleted:SetText( If( ( oBrw:cAlias )->( Deleted() ),;
"DELETED", "NON DELETED" ) ),;
oMsgDeleted:SetBitmap( If( ( oBrw:cAlias )->( Deleted() ),;
"deleted", "nondeleted" ) ) )
oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW
oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
{ If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, CLR_BLACK ),;
RGB( 198, 255, 198 ) }, ;
{ If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, CLR_BLACK ),;
RGB( 232, 255, 232 ) } ) }
oBrw:bClrSel = { || { If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, CLR_WHITE ),;
RGB( 0x33, 0x66, 0xCC ) } }
cClrBack = Eval( oBrw:bClrSelFocus )[ 2 ]
oBrw:bClrSelFocus = { || { If( ( oBrw:cAlias )->( Deleted() ), CLR_HRED, CLR_WHITE ),;
cClrBack } }
oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
oBrw:CreateFromCode()
oBrw:SetFocus()
oBrw:bLDblClick = { || ( oBrw:cAlias )->( Edit() ) }
oWnd:oClient = oBrw
DEFINE MSGBAR oMsgBar PROMPT "Alias: " + Alias() + " | RecNo: " + ;
AllTrim( Str( RecNo() ) ) + "/" + ;
AllTrim( Str( RecCount() ) ) ;
OF oWnd 2010
DEFINE MSGITEM oMsgTagName OF oMsgBar ;
PROMPT "Ordered by: " + ;
If( ! Empty( ( oBrw:cAlias )->( OrdName() ) ),;
( oBrw:cAlias )->( OrdName() ), "Natural order" ) ;
SIZE 150
DEFINE MSGITEM oMsgDeleted OF oMsgBar ;
PROMPT If( ( oBrw:cAlias )->( Deleted() ), "DELETED", "NON DELETED" ) ;
SIZE 130 ;
BITMAPS "nondeleted" ;
ACTION ( oBrw:cAlias )->( DelRecord( oBrw, oMsgDeleted ) )
ACTIVATE WINDOW oWnd ;
VALID ( ( cAlias )->( DbCloseArea() ), oBrw:cAlias := "", .T. )
return nil
//----------------------------------------------------------------------------//
function DelRecord( oBrw, oMsgDeleted )
if ! Deleted()
if ! MsgYesNo( "Want to delete this record ?" )
return nil
endif
DbRLock()
DbDelete()
DbUnlock()
oMsgDeleted:SetText( "DELETED" )
oMsgDeleted:SetBitmap( "deleted" )
else
DbRLock()
DbRecall()
DbUnlock()
oMsgDeleted:SetText( "NON DELETED" )
oMsgDeleted:SetBitmap( "nondeleted" )
MsgInfo( "UnDeleted record" )
endif
Eval( oBrw:bChange )
oBrw:Refresh()
return nil
//----------------------------------------------------------------------------//
function Edit()
local oWnd, aRecord := ( Alias() )->( LoadRecord() ), oBar, oBrw, oMsgBar
local cAlias := Alias(), oBtnSave, nRecNo := ( Alias() )->( RecNo() )
local oMsgDeleted
DEFINE WINDOW oWnd TITLE "Edit " + Alias() MDICHILD
oWndMain:oBar:AEvalWhen()
DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70
DEFINE BUTTON oBtnSave OF oBar PROMPT "Save" RESOURCE "save" ;
ACTION ( ( cAlias )->( SaveRecord( aRecord, nRecNo ) ), oBtnSave:Disable() )
oBtnSave:Disable()
DEFINE BUTTON OF oBar PROMPT "Prev" RESOURCE "prev" ;
ACTION GoPrevRecord( oBrw, aRecord, oMsgDeleted ) GROUP
DEFINE BUTTON OF oBar PROMPT "Next" RESOURCE "next" ;
ACTION GoNextRecord( oBrw, aRecord, oMsgDeleted ) GROUP
DEFINE BUTTON OF oBar PROMPT "Report" RESOURCE "report" ;
ACTION oBrw:Report()
DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
ACTION oWnd:End() GROUP
@ 0, 0 XBROWSE oBrw OF oWnd ARRAY aRecord AUTOCOLS LINES ;
HEADERS "FieldName", "Value" COLSIZES 150, 400 FASTEDIT ;
ON CHANGE ( ( cAlias )->( SetEditType( oBrw, oBtnSave ) ), oBrw:DrawLine( .T. ),;
oMsgBar:cMsgDef := " RecNo: " + AllTrim( Str( ( cAlias )->( RecNo() ) ) ) + ;
"/" + AllTrim( Str( ( cAlias )->( RecCount() ) ) ),;
oMsgBar:Refresh() )
oBrw:nEditTypes = EDIT_GET
oBrw:aCols[ 1 ]:nEditType = 0 // Don't allow to edit first column
oBrw:aCols[ 2 ]:bOnChange = { || oBtnSave:Enable() }
oBrw:aCols[ 2 ]:lWillShowABtn = .T.
oBrw:nMarqueeStyle = MARQSTYLE_HIGHLROW
oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
{ CLR_BLACK, RGB( 198, 255, 198 ) }, ;
{ CLR_BLACK, RGB( 232, 255, 232 ) } ) }
oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }
oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
oBrw:CreateFromCode()
oBrw:SetFocus()
oWnd:oClient = oBrw
DEFINE MSGBAR oMsgBar ;
PROMPT " RecNo: " + AllTrim( Str( ( cAlias )->( RecNo() ) ) ) + "/" + ;
AllTrim( Str( ( cAlias )->( RecCount() ) ) ) OF oWnd 2010
DEFINE MSGITEM oMsgDeleted OF oMsgBar ;
PROMPT If( ( cAlias )->( Deleted() ), "DELETED", "NON DELETED" ) ;
SIZE 130 ;
BITMAPS If( ( cAlias )->( Deleted() ), "deleted", "nondeleted" ) ;
ACTION ( cAlias )->( DelRecord( oBrw, oMsgDeleted ) )
ACTIVATE WINDOW oWnd
return nil
//----------------------------------------------------------------------------//
function GoPrevRecord( oBrw, aRecord, oMsgDeleted )
DbSkip( -1 )
oBrw:SetArray( aRecord := LoadRecord() )
oBrw:SetFocus()
Eval( oBrw:bChange )
oMsgDeleted:SetText( If( Deleted(), "DELETED", "NON DELETED" ) )
oMsgDeleted:SetBitmap( If( Deleted(), "deleted", "nondeleted" ) )
return nil
//----------------------------------------------------------------------------//
function GoNextRecord( oBrw, aRecord, oMsgDeleted )
DbSkip( 1 )
If Eof()
DbSkip( -1 )
else
oBrw:SetArray( aRecord := LoadRecord() )
oBrw:SetFocus()
Eval( oBrw:bChange )
endif
oMsgDeleted:SetText( If( Deleted(), "DELETED", "NON DELETED" ) )
oMsgDeleted:SetBitmap( If( Deleted(), "deleted", "nondeleted" ) )
return nil
//----------------------------------------------------------------------------//
function SetEditType( oBrw, oBtnSave )
local cType := FieldType( oBrw:nArrayAt )
do case
case cType == "M"
oBrw:aCols[ 2 ]:nEditType = EDIT_BUTTON
oBrw:aCols[ 2 ]:bEditBlock = { | c | c := oBrw:aRow[ 2 ],;
MemoEdit( @oBrw:aRow[ 2 ], FieldName( oBrw:nArrayAt ) ),;
If( ! c == oBrw:aRow[ 2 ], oBtnSave:Enable(),),;
oBrw:aRow[ 2 ] }
case cType == "D"
oBrw:aCols[ 2 ]:nEditType = EDIT_BUTTON
oBrw:aCols[ 2 ]:bEditBlock = { || If( ! Empty( oBrw:aRow[ 2 ] ) .and. ;
! AllTrim( oBrw:aRow[ 2 ] ) == "/ /",;
DToC( MsgDate( CtoD( oBrw:aRow[ 2 ] ) ) ),;
DToC( MsgDate( Date() ) ) ) }
case cType == "L"
oBrw:aCols[ 2 ]:nEditType = EDIT_LISTBOX
oBrw:aCols[ 2 ]:aEditListTxt = { ".T.", ".F." }
otherwise
oBrw:aCols[ 2 ]:nEditType = EDIT_GET
endcase
return nil
//----------------------------------------------------------------------------//
function IndexBuilder()
local oDlg, cKey := Space( 80 )
DEFINE DIALOG oDlg TITLE "Index builder" SIZE 600, 500
oDlg:lDesign = .T.
@ 0.5, 2 SAY "Index on" OF oDlg SIZE 40, 8
@ 1.4, 1 GET cKey OF oDlg SIZE 140, 11 ACTION ExpBuilder()
@ 0.5, 15 SAY "Tag" OF oDlg SIZE 40, 8
ACTIVATE DIALOG oDlg CENTERED
return nil
//----------------------------------------------------------------------------//
function Indexes()
local oWnd, oBar, oBrw, oMsgBar
local cAlias := Alias(), aIndexes := {}, n
for n = 1 to 15
if ! Empty( OrdName( n ) )
AAdd( aIndexes, { n,;
OrdName( n ),;
OrdKey( n ),;
OrdFor( n ),;
OrdBagName( n ),;
OrdBagExt( n ) } )
endif
next
DEFINE WINDOW oWnd TITLE "Indexes of " + Alias() MDICHILD
oWndMain:oBar:AEvalWhen()
DEFINE BUTTONBAR oBar OF oWnd 2010 SIZE 70, 70
DEFINE BUTTON OF oBar PROMPT "Add" RESOURCE "add" ;
ACTION ( MsgInfo( "Add Tag" ), oBrw:Refresh(), oBrw:SetFocus() )
DEFINE BUTTON OF oBar PROMPT "Edit" RESOURCE "edit" ;
ACTION ( MsgInfo( "Edit" ) )
DEFINE BUTTON OF oBar PROMPT "Del" RESOURCE "del" ;
ACTION If( MsgYesNo( "Want to delete this tag ?" ),;
( ( cAlias )->( OrdBagClear( oBrw:nArrayAt ) ), oBrw:Refresh() ),)
DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
ACTION oWnd:End() GROUP
@ 0, 0 XBROWSE oBrw OF oWnd ARRAY aIndexes AUTOCOLS LINES ;
HEADERS "Order", "TagName", "Expression", "For", "BagName", "BagExt" ;
COLSIZES 50, 150, 400, 400, 150, 150
oBrw:nMarqueeStyle = MARQSTYLE_HIGHLROW
oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
{ CLR_BLACK, RGB( 198, 255, 198 ) }, ;
{ CLR_BLACK, RGB( 232, 255, 232 ) } ) }
oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }
oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
oBrw:CreateFromCode()
oBrw:SetFocus()
oWnd:oClient = oBrw
DEFINE MSGBAR oMsgBar 2010
ACTIVATE WINDOW oWnd
return nil
//----------------------------------------------------------------------------//
function ExpBuilder()
local oDlg
DEFINE DIALOG oDlg TITLE "Expression builder"
ACTIVATE DIALOG oDlg CENTERED
return nil
//----------------------------------------------------------------------------//
function LoadRecord()
local aRecord := {}, n
for n = 1 to FCount()
AAdd( aRecord, { FieldName( n ), FieldGet( n ) } )
next
return aRecord
//----------------------------------------------------------------------------//
function Search( oBrw )
local oDlg, oCbx, cSearch := Space( 50 )
local nRecNo := RecNo(), lInc := .T.
DEFINE DIALOG oDlg TITLE "Search: " + Alias() SIZE 400, 200
@ 0.5, 1.5 SAY "Ordered by: " + OrdName() OF oDlg
@ 1.2, 1.5 SAY "Key: " + OrdKey() OF oDlg
@ 2.4, 1.2 COMBOBOX oCbx VAR cSearch ITEMS aSearches OF oDlg SIZE 180, 150 ;
STYLE CBS_DROPDOWN
oCbx:oGet:bChange = { || DbSeek( AllTrim( oCbx:GetText() ), lInc ), oBrw:Refresh() }
@ 3.7, 1.5 CHECKBOX lInc PROMPT "&Incremental" OF oDlg SIZE 80, 10
@ 4, 7 BUTTON "&Ok" OF oDlg SIZE 45, 13 ;
ACTION ( If( ! DbSeek( AllTrim( cSearch ), lInc ), DbGoTo( nRecNo ),),;
AAdd( aSearches, AllTrim( cSearch ) ), oDlg:End() )
@ 4, 18 BUTTON "&Cancel" OF oDlg SIZE 45, 13 ACTION oDlg:End()
ACTIVATE DIALOG oDlg CENTERED
return nil
//----------------------------------------------------------------------------//
function SaveRecord( aRecord, nRecNo )
local n
( Alias() )->( DbGoTo( nRecNo ) )
if ( Alias() )->( DbRLock( nRecNo ) )
for n = 1 to Len( aRecord )
( Alias() )->( FieldPut( n, aRecord[ n ][ 2 ] ) )
next
( Alias() )->( DbUnLock() )
MsgInfo( "Record updated" )
else
MsgAlert( "Record in use, please try it again" )
endif
return nil
//----------------------------------------------------------------------------//
function Struct()
local oDlg, oBrw, aFields := DbStruct()
DEFINE DIALOG oDlg TITLE Alias() + " fields" SIZE 400, 400
@ 0, 0 XBROWSE oBrw ARRAY aFields AUTOCOLS LINES ;
HEADERS "Name", "Type", "Len", "Dec" ;
COLSIZES 150, 50, 80, 80
oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW
oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
{ CLR_BLACK, RGB( 198, 255, 198 ) }, ;
{ CLR_BLACK, RGB( 232, 255, 232 ) } ) }
oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }
oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
oBrw:CreateFromCode()
oDlg:oClient = oBrw
ACTIVATE DIALOG oDlg CENTERED ;
ON INIT ( BuildStructBar( oDlg, oBrw ), oDlg:Resize(), oBrw:SetFocus() )
return nil
//----------------------------------------------------------------------------//
function BuildStructBar( oDlg, oBrw )
local oBar
DEFINE BUTTONBAR oBar OF oDlg 2010 SIZE 70, 70
DEFINE BUTTON OF oBar PROMPT "Code" RESOURCE "code" ;
ACTION ( TxtStruct(), oBrw:SetFocus() )
DEFINE BUTTON OF oBar PROMPT "Exit" RESOURCE "exit" ;
ACTION oDlg:End() GROUP
return nil
//----------------------------------------------------------------------------//
function TxtStruct()
local cCode := "local aFields := { ", n
for n = 1 to FCount()
if n > 1
cCode += Space( 27 )
endif
cCode += '{ "' + FieldName( n ) + '", "' + ;
FieldType( n ) + '", ' + ;
AllTrim( Str( FieldLen( n ) ) ) + ", " + ;
AllTrim( Str( FieldDec( n ) ) ) + " },;" + CRLF
next
cCode = SubStr( cCode, 1, Len( cCode ) - 4 ) + " }"
MemoEdit( cCode, "Code" )
return nil
//----------------------------------------------------------------------------//
function New()
local oDlg, oGet, oBrw
local cFieldName := Space( 10 ), cType, nLen := 10, nDec := 0
local aFields := { Array( 4 ) }, cDbfName := Space( 8 ), aTemp
DEFINE DIALOG oDlg TITLE "DBF builder" SIZE 415, 400
@ 0.5, 2 SAY "Field Name" OF oDlg SIZE 40, 8
@ 0.5, 10 SAY "Type" OF oDlg SIZE 40, 8
@ 0.5, 17 SAY "Len" OF oDlg SIZE 40, 8
@ 0.5, 22 SAY "Dec" OF oDlg SIZE 20, 8
@ 1.4, 1 GET oGet VAR cFieldName PICTURE "!!!!!!!!!!" OF oDlg SIZE 41, 11
@ 1.3, 6.5 COMBOBOX cType ITEMS { "Character", "Number", "Date", "Logical", "Memo" } ;
OF oDlg ON CHANGE ( If( cType == "Character", ( nLen := 10, nDec := 0 ),),;
If( cType == "Number", nDec := 0,),;
If( cType == "Date", ( nLen := 8, nDec := 0 ),),;
If( cType == "Logical", ( nLen := 1, nDec := 0 ),),;
If( cType == "Memo", ( nLen := 10, nDec := 0 ),),;
oDlg:Update() )
@ 1.4, 11.9 GET nLen PICTURE "999" OF oDlg SIZE 25, 11 UPDATE
@ 1.4, 15.4 GET nDec PICTURE "999" OF oDlg SIZE 25, 11 WHEN cType = "Number" UPDATE
@ 0.9, 26 BUTTON "&Add" OF oDlg SIZE 45, 13 ;
ACTION AddField( @aFields, @cFieldName, @cType, @nLen, @nDec, oGet, oBrw )
@ 2.2, 2 SAY "Fields" OF oDlg SIZE 40, 8
@ 3.2, 1 XBROWSE oBrw ARRAY aFields AUTOCOLS ;
HEADERS "Name", "Type", "Len", "Dec" ;
COLSIZES 90, 55, 40, 40 ;
SIZE 140, 130 OF oDlg
oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW
oBrw:bClrStd = { || If( oBrw:KeyNo() % 2 == 0, ;
{ CLR_BLACK, RGB( 198, 255, 198 ) }, ;
{ CLR_BLACK, RGB( 232, 255, 232 ) } ) }
oBrw:bClrSel = { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }
oBrw:SetColor( CLR_BLACK, RGB( 232, 255, 232 ) )
oBrw:CreateFromCode()
@ 2.4, 26 BUTTON "&Edit" OF oDlg SIZE 45, 13
@ 3.4, 26 BUTTON "&Delete" OF oDlg SIZE 45, 13
@ 4.4, 26 BUTTON "Move &Up" OF oDlg SIZE 45, 13 ;
ACTION If( oBrw:nArrayAt > 1,;
( aTemp := aFields[ oBrw:nArrayAt ],;
aFields[ oBrw:nArrayAt ] := aFields[ oBrw:nArrayAt - 1 ],;
aFields[ oBrw:nArrayAt - 1 ] := aTemp,;
oBrw:GoUp() ),)
@ 5.4, 26 BUTTON "Move D&own" OF oDlg SIZE 45, 13 ;
ACTION If( oBrw:nArrayAt < Len( aFields ),;
( aTemp := aFields[ oBrw:nArrayAt ],;
aFields[ oBrw:nArrayAt ] := aFields[ oBrw:nArrayAt + 1 ],;
aFields[ oBrw:nArrayAt + 1 ] := aTemp,;
oBrw:GoDown() ),)
@ 12.1, 2 SAY "DBF Name:" OF oDlg SIZE 30, 8
@ 14, 6 GET cDbfName PICTURE "!!!!!!!!!!!!" OF oDlg SIZE 100, 11
@ 10, 26 BUTTON "&Create" OF oDlg SIZE 45, 13 ;
ACTION ( If( ! Empty( cDbfName ) .and. Len( aFields ) > 0,;
DbCreate( AllTrim( cDbfName ), aFields ),), oDlg:End(),;
Open( hb_CurDrive() + ":\" + CurDir() + "\" + AllTrim( cDbfName ) ) )
ACTIVATE DIALOG oDlg CENTERED
return nil
//----------------------------------------------------------------------------//
function AddField( aFields, cFieldName, cType, nLen, nDec, oGet, oBrw )
if Empty( cFieldName )
oGet:SetPos( 0 )
return nil
endif
if Len( aFields ) == 1 .and. Empty( aFields[ 1 ][ 1 ] )
aFields = { { cFieldName, Upper( Left( cType, 1 ) ), nLen, nDec } }
else
AAdd( aFields, { cFieldName, Upper( Left( cType, 1 ) ), nLen, nDec } )
endif
oBrw:SetArray( aFields )
oGet:VarPut( cFieldName := Space( 10 ) )
oGet:SetPos( 0 )
oGet:SetFocus()
oBrw:GoBottom()
return nil
//----------------------------------------------------------------------------//
function OrdTagsCount()
local n, nCount := 0
for n = 1 to 100
if ! Empty( OrdName( n ) )
nCount++
endif
next
return nCount
//----------------------------------------------------------------------------//
#pragma BEGINDUMP
#include <hbapi.h>
#include <hbapirdd.h>
HB_FUNC( ORDCONDGET )
{
AREAP pArea = ( AREAP ) hb_rddGetCurrentWorkAreaPointer();
if( pArea )
{
LPDBORDERCONDINFO lpdbOrdCondInfo = pArea->lpdbOrdCondInfo;
if( lpdbOrdCondInfo && lpdbOrdCondInfo->abWhile )
hb_retc( lpdbOrdCondInfo->abWhile );
else
hb_retc( "" );
}
else
hb_retc( "" );
}
#pragma ENDDUMP
//----------------------------------------------------------------------------//
-
Antonio Linares - Site Admin
- Posts: 42089
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
Re: FiveDBU for 32/64 bits
by ukoenig » Sun Jun 03, 2012 9:53 pm
Antonio,
does it make sense ?
Adding a Image-info to a field, You can preview this file.
It is just a start, but works fine.
Best Regards
Uwe
does it make sense ?
Adding a Image-info to a field, You can preview this file.
It is just a start, but works fine.
Best Regards
Uwe
Since 1995 ( the first release of FW 1.9 )
i work with FW.
If you have any questions about special functions, maybe i can help.
i work with FW.
If you have any questions about special functions, maybe i can help.
-
ukoenig - Posts: 4043
- Joined: Wed Dec 19, 2007 6:40 pm
- Location: Germany
Re: FiveDBU for 32/64 bits
by Otto » Mon Jun 04, 2012 7:37 am
Hello Antonio,
On my 2008 R2 I have to command ON PAINT.
Best regards,
Otto
ACTIVATE WINDOW oWndMain MAXIMIZED ;
VALID MsgYesNo( "Want to end ?" ) //;
// ON PAINT DrawTiled( hDC, oWndMain, oBmpTiled )
On my 2008 R2 I have to command ON PAINT.
Best regards,
Otto
ACTIVATE WINDOW oWndMain MAXIMIZED ;
VALID MsgYesNo( "Want to end ?" ) //;
// ON PAINT DrawTiled( hDC, oWndMain, oBmpTiled )
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
-
Otto - Posts: 6332
- Joined: Fri Oct 07, 2005 7:07 pm
Re: FiveDBU for 32/64 bits
by Otto » Mon Jun 04, 2012 7:53 am
Hello Antonio,
Would you please insert field - info on "click on header" like in xWDBU.
Best regards,
Otto
Would you please insert field - info on "click on header" like in xWDBU.
Best regards,
Otto
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
-
Otto - Posts: 6332
- Joined: Fri Oct 07, 2005 7:07 pm
Re: FiveDBU for 32/64 bits
by Otto » Mon Jun 04, 2012 7:57 am
Hello Antonio,
where can I download the bitmaps.
Thanks in advance
Otto
where can I download the bitmaps.
Thanks in advance
Otto
pplication
===========
Path and name: C:\fwh\samples\fivedbu.exe (32 bits)
Size: 2,192,384 bytes
Compiler version: xHarbour build 1.2.1 Intl. (SimpLex) (Rev. 6715)
FiveWin Version: FWHX 12.03
Windows version: 6.1, Build 7601 Service Pack 1
Time from start: 0 hours 4 mins 7 secs
Error occurred at: 04/06/2012, 09:54:37
Error description: Warning BASE/1004 Message not found: TMSGITEM:SETBITMAP
Stack Calls
===========
Called from: source\rtl\tobject.prg => TMSGITEM:ERROR( 172 )
Called from: source\rtl\tobject.prg => TMSGITEM:MSGNOTFOUND( 205 )
Called from: source\rtl\tobject.prg => TMSGITEM:SETBITMAP( 0 )
Called from: C:\fwh\samples\fivedbu.prg => (b)OPEN( 176 )
Called from: => EVAL( 0 )
Called from: C:\fwh\samples\fivedbu.prg => (b)OPEN( 115 )
Called from: .\source\classes\MENU.PRG => TMENU:ACTIVATE( 494 )
Called from: .\source\classes\BTNBMP.PRG => TBTNBMP:LBUTTONUP( 646 )
Called from: .\source\classes\CONTROL.PRG => TCONTROL:HANDLEEVENT( 1690 )
Called from: .\source\classes\BTNBMP.PRG => TBTNBMP:HANDLEEVENT( 1408 )
Called from: .\source\classes\WINDOW.PRG => _FWH( 3153 )
Called from: => WINRUN( 0 )
Called from: .\source\classes\WINDOW.PRG => TMDIFRAME:ACTIVATE( 980 )
Called from: C:\fwh\samples\fivedbu.prg => MAIN( 39 )
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
-
Otto - Posts: 6332
- Joined: Fri Oct 07, 2005 7:07 pm
Re: FiveDBU for 32/64 bits
by ukoenig » Mon Jun 04, 2012 11:45 am
Otto,
I created a complete new Image-set.
These Images are saved as 24 Bit with NO Alphachannel ( still shows a transparent-effect ).
That makes it possible, to save / use them from Resources.
I can add the Download-link, if needed.
Best Regards
Uwe 
I created a complete new Image-set.
These Images are saved as 24 Bit with NO Alphachannel ( still shows a transparent-effect ).
That makes it possible, to save / use them from Resources.
I can add the Download-link, if needed.
Best Regards
Uwe
Last edited by ukoenig on Mon Jun 04, 2012 11:51 am, edited 1 time in total.
Since 1995 ( the first release of FW 1.9 )
i work with FW.
If you have any questions about special functions, maybe i can help.
i work with FW.
If you have any questions about special functions, maybe i can help.
-
ukoenig - Posts: 4043
- Joined: Wed Dec 19, 2007 6:40 pm
- Location: Germany
Re: FiveDBU for 32/64 bits
by Antonio Linares » Mon Jun 04, 2012 11:49 am
Uwe,
Very nice bitmaps!
Where to download them from ?
Thanks!
Very nice bitmaps!
Where to download them from ?
Thanks!
-
Antonio Linares - Site Admin
- Posts: 42089
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
Re: FiveDBU for 32/64 bits
by Antonio Linares » Mon Jun 04, 2012 11:50 am
Otto,
What would be better, to show the field info or to automatic index / sort on that field ?
What would be better, to show the field info or to automatic index / sort on that field ?
-
Antonio Linares - Site Admin
- Posts: 42089
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
Re: FiveDBU for 32/64 bits
by Otto » Mon Jun 04, 2012 12:18 pm
Hello Antonio,
for everyday work the index would be better. Maybe you can show the field info on right click on header.
Best regards,
Otto
for everyday work the index would be better. Maybe you can show the field info on right click on header.
Best regards,
Otto
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
-
Otto - Posts: 6332
- Joined: Fri Oct 07, 2005 7:07 pm
Return to FiveWin for Harbour/xHarbour
Who is online
Users browsing this forum: No registered users and 89 guests