Frank,
This is what I have got from you. I don't see exactly what you mean
Antonio Linares wrote:Frank,
This is what I have got from you. I don't see exactly what you mean
#include 'fivewin.ch'
#include 'xbrowse.ch'
REQUEST DBFCDX
#DEFINE EXENAME "xWDBU"
static oWndDbu, oDbfWnd
//----------------------------------------------------------------------------//
function Main()
local oBrw, oFont
SetBalloon( .t. )
xbrNumformat( ,.t. )
SET XBROWSE TO TXBrCode()
DEFINE FONT oFont NAME 'TAHOMA' SIZE 0,-12
DEFINE WINDOW oWndDbu MDI ;
TITLE 'DBU for Windows' ;
MENU MainMenu()
oWndDbu:SetFont( oFont )
// MakeBar( oWndDbu )
// oWnd:oBar:cToolTip := { || "My Color" }
SET MESSAGE OF oWndDbu TO 'Developed with Harbour and FWH (FiveWin for Harbour/xHarbour)' 2007 DATE CLOCK KEYBOARD
ACTIVATE WINDOW oWndDbu ;
ON DROPFILES Files2Brw( nRow, nCol, aFiles )
return nil
//----------------------------------------------------------------------------//
INIT PROCEDURE PrgInit
SET DELETED ON
SET EXCLUSIVE OFF
SET DATE ITALIAN
SET CENTURY ON
RDDSetDefault( 'DBFCDX' )
return
//----------------------------------------------------------------------------//
static function MakeBar( oWndDbu )
local oBar
DEFINE BUTTONBAR oBar OF oWndDbu SIZE 56,64 2007
DEFINE BUTTON OF oBar PROMPT 'Open Data' ;
RESOURCE 'Open' ;
ACTION NewFile()
DEFINE BUTTON OF oBar PROMPT 'dbfbuild' ;
RESOURCE 'Open' ;
ACTION dbfbuild()
return oBar
//----------------------------------------------------------------------------//
static function MainMenu()
local oMenu, URLNAME := "http://www.fivetechsoft.com"
MENU oMenu 2007
MENUITEM "File"
MENU
MENUITEM "&New"+chr(9)+"Ctrl+U" ;
RESOURCE "NEW" ;
ACTION NewFile(dbfbuild()) ; //MsgInfo( "Fbrowse(DbfBuild(),.t.) ") ;
MESSAGE "Create new file" ;
ACCELERATOR ACC_CONTROL, asc("U") ;
ENABLED
MENUITEM "&Open"+chr(9)+"Ctrl+A" ;
RESOURCE "OPEN" ;
ACTION NewFile() ;
MESSAGE "Open file" ;
ACCELERATOR ACC_CONTROL, asc("A") ;
ENABLED
MENUITEM "C&lose"+chr(9)+"Ctrl+E" ;
RESOURCE "SAVE" ;
ACTION oWndDbu:oWnd:End() ;
MESSAGE "Close file" ;
ACCELERATOR ACC_CONTROL, asc("E") ;
ENABLED
MENUITEM "&Print"+chr(9)+"Ctrl+T" ;
RESOURCE "PRINTER" ;
ACTION MsgInfo( " oDbfWnd:Report() ") ;
MESSAGE "Print file" ;
ACCELERATOR ACC_CONTROL, asc("T") ;
ENABLED
MENUITEM "Command &Interpreter" ;
RESOURCE "DOT" ;
ACTION MsgInfo( " DotNew() ");
MESSAGE "Invokes the command interpreter" ;
ENABLED
MENUITEM "&Modify structure"+chr(9)+"Ctrl+M" ;
RESOURCE "DESIGN" ;
ACTION NewFile(dbfbuild()) ;
MESSAGE "Modify file structure" ;
ACCELERATOR ACC_CONTROL, asc("M") ;
ENABLED
MENUITEM "Multi-&file operation" ;
RESOURCE "MULTFILE" ;
ACTION MsgInfo( " MultiFile() ");
MESSAGE "&Multi-file operation" ;
ENABLED
MENUITEM "Import from ODBC database" ;
RESOURCE "IMPORT" ;
ACTION MsgInfo( " ImportODBC(oWnd) ");
MESSAGE "Import data from a ODBC database" ;
ENABLED
MENUITEM "&Configuration" ;
RESOURCE "CONFIG" ;
ACTION MsgInfo( " AppConfig() ");
MESSAGE "Program configuration" ;
ENABLED
SEPARATOR
MENUITEM "Specif&y printer" ;
RESOURCE "PROPERTY" ;
ACTION PrinterSetup() ;
MESSAGE "Printer configuration" ;
ENABLED
MENUITEM "&Map Network Drive" ;
RESOURCE "NETCONNE" ;
ACTION MsgInfo(" WNetConnectDialog() ") ;
MESSAGE "Connect to a network drive" ;
ENABLED
MENUITEM "&Disconnect Network Drive" ;
RESOURCE "NETDISCO" ;
ACTION MsgInfo(" WNetDisconnect() ") ;
MESSAGE "Disconnect from a network drive" ;
ENABLED
MENUITEM "&Exit"+chr(9)+"Alt+F4" ;
RESOURCE "EXIT" ;
ACTION oWndDbu:End() ;
MESSAGE "Exit from the application" ;
ENABLED
ENDMENU
MENUITEM "&Edit"
MENU
MENUITEM "&Copy record"+chr(9)+"Ctrl+C" ;
RESOURCE "COPY" ;
ACTION MsgInfo( " oDbfWnd:CopyRec() ") ;
MESSAGE "Copy record to the Clipboard" ;
ACCELERATOR ACC_CONTROL, asc("C") ;
ENABLED
MENUITEM "&Paste record"+chr(9)+"Ctrl+V" ;
RESOURCE "PASTE" ;
ACTION MsgInfo( " oDbfWnd:PasteRec() ");
MESSAGE "Paste record from the Clipboard" ;
ACCELERATOR ACC_CONTROL, asc("V")
SEPARATOR
MENUITEM "&Insert record"+chr(9)+"Ctrl+Insert" ;
RESOURCE "NEW" ;
ACTION oDbfWnd:AppRec();
MESSAGE "Append record" ;
ACCELERATOR ACC_CONTROL, VK_INSERT ;
ENABLED
MENUITEM "&Del/Recall record"+chr(9)+"Ctrl+Del" ;
RESOURCE "DEL" ;
ACTION oDbfWnd:DelRec() ;
MESSAGE "Del actual record" ;
ACCELERATOR ACC_CONTROL, VK_DELETE ;
ENABLED
MENUITEM "&Edit field"+chr(9)+"Enter" ;
RESOURCE "TEXTBOX" ;
ACTION MsgInfo( " oDbfWnd:EditFld() ");
MESSAGE "Edit actual record field" ;
ENABLED
//ACCELERATOR ACC_SHIFT, VK_RETURN ;
MENUITEM "&Edit record"+chr(9)+"CTRL+Enter" ;
RESOURCE "EDIT" ;
ACTION oDbfWnd:EditRec();
MESSAGE "Edit actual record (all fields)" ;
ENABLED
//ACCELERATOR ACC_CONTROL, VK_RETURN ;
ENDMENU
MENUITEM "&Navigation"
MENU
MENUITEM "&Search"+chr(9)+"Ctrl+S" ;
RESOURCE "SEARCH" ;
ACTION MsgInfo( " oDbfWnd:Seek() ");
MESSAGE "Search records using the active index" ;
ACCELERATOR ACC_CONTROL, asc("S") ;
ENABLED
MENUITEM "&Go to"+chr(9)+"Ctrl+G" ;
ACTION MsgInfo( " oDbfWnd:Ira() ");
MESSAGE "Jump to a record by its Recno()" ;
ACCELERATOR ACC_CONTROL, asc("G") ;
ENABLED
MENUITEM "S&kip"+chr(9)+"Ctrl+K" ;
ACTION MsgInfo( " oDbfWnd:Skip() ");
MESSAGE "Skip records" ;
ACCELERATOR ACC_CONTROL, asc("K") ;
ENABLED
SEPARATOR
MENUITEM "&Locate"+chr(9)+"F3" ;
ACTION MsgInfo( " oDbfWnd:Locate() ");
MESSAGE "Locate record" ;
ACCELERATOR ACC_NORMAL, VK_F3 ;
ENABLED
MENUITEM "&Continue"+chr(9)+"F4" ;
ACTION MsgInfo( " oDbfWnd:Locate(.T.)") ;
MESSAGE "Locate next record" ;
ACCELERATOR ACC_NORMAL, VK_F4 ;
ENABLED
ENDMENU
MENUITEM "&Indexes"
MENU
MENUITEM OemtoAnsi("&Open Index"+chr(9)+"Ctrl+X") ;
RESOURCE "OPEN" ;
ACTION MsgInfo( " oDbfWnd:OpenIndex() ");
MESSAGE "Select an index file" ;
ACCELERATOR ACC_CONTROL, asc("X") ;
ENABLED
MENUITEM OemtoAnsi("&Close Index"+chr(9)+"Ctrl+L") ;
RESOURCE "SAVE" ;
ACTION MsgInfo( " oDbfWnd:CloseIndex()") ;
MESSAGE "Close current index file" ;
ACCELERATOR ACC_CONTROL, asc("L") ;
ENABLED
MENUITEM "&Previous order"+chr(9)+"Ctrl+P" ;
RESOURCE "PREV" ;
ACTION MsgInfo( " oDbfWnd:PrevOrder()");
MESSAGE "Go to previous order" ;
ACCELERATOR ACC_CONTROL, asc("P") ;
ENABLED
MENUITEM "&Next order"+chr(9)+"Ctrl+N" ;
RESOURCE "NEXT" ;
ACTION MsgInfo( " oDbfWnd:NextOrder() ");
MESSAGE "Go to next order" ;
ACCELERATOR ACC_CONTROL, asc("N") ;
ENABLED
MENUITEM OemtoAnsi("&Filter by scope"+chr(9)+"Ctrl+F") ;
RESOURCE "FILTER" ;
ACTION MsgInfo( " oDbfWnd:Scope() ");
MESSAGE "Set a scope to filter records, based on the active index" ;
ACCELERATOR ACC_CONTROL, asc("F") ;
ENABLED
MENUITEM OemtoAnsi("&Create new index"+chr(9)+"Ctrl+W") ;
RESOURCE "INDEX" ;
ACTION MsgInfo( " oDbfWnd:BuildIndex() ");
MESSAGE "Create a new index file or Tag" ;
ACCELERATOR ACC_CONTROL, asc("W") ;
ENABLED
SEPARATOR
MENUITEM "&Delete Order" ;
RESOURCE "DEL" ;
ACTION MsgInfo( " oDbfWnd:DelTag() ");
MESSAGE "Delete current Order (Tag)" ;
ENABLED
MENUITEM "&Reindex"+chr(9)+"Ctrl+R" ;
RESOURCE "REPEAT" ;
ACTION MsgInfo( " oDbfWnd:Reindex() ");
MESSAGE "Reindex all the open indexes" ;
ACCELERATOR ACC_CONTROL, asc("R") ;
ENABLED
ENDMENU
MENUITEM "&Utilities"
MENU
MENUITEM "&More information"+chr(9)+"Ctrl+I" ;
RESOURCE "PROPERTY" ;
ACTION MsgInfo( " oDbfWnd:Info() ");
MESSAGE "Show additional information about the current file" ;
ACCELERATOR ACC_CONTROL, asc("I") ;
ENABLED
MENUITEM "&Browse Columns"+chr(9)+"Ctrl+B" ;
RESOURCE "TBROWSE" ;
ACTION MsgInfo( " oDbfWnd:SetColumn() ");
MESSAGE "Columns configuration" ;
ACCELERATOR ACC_CONTROL, asc("B") ;
ENABLED
MENUITEM "&Relations" ;
RESOURCE "CHAIN" ;
ACTION MsgInfo( " oDbfWnd:Relations() ");
MESSAGE "Establish relations with other databases" ;
ENABLED
MENUITEM "Establish &Filter" ;
RESOURCE "FILTER" ;
ACTION MsgInfo( " oDbfWnd:Filter() ");
MESSAGE "Set the criteria by which to filter records" ;
ENABLED
MENUITEM "Coun&t" ;
ACTION MsgInfo( " oDbfWnd:Count() ");
MESSAGE "Count the number of records meeting a certain criteria" ;
ENABLED
MENUITEM "&Statistics" ;
RESOURCE "STATICS" ;
ACTION MsgInfo( " oDbfWnd:Sum() ");
MESSAGE "Statistics calculations of all numeric fields" ;
ENABLED
MENUITEM "&Graphics" ;
RESOURCE "GRAPH" ;
ACTION MsgInfo( " oDbfWnd:Graphics() ");
MESSAGE "Graphics based on current data file" ;
ENABLED
SEPARATOR
MENUITEM "&Append from..." ;
RESOURCE "IMPORT" ;
ACTION MsgInfo( " oDbfWnd:AppendFrom() ");
MESSAGE "Append records from another file" ;
ENABLED
MENUITEM "&Copy to..." ;
RESOURCE "COPY" ;
ACTION MsgInfo( " oDbfWnd:CopyTo() ");
MESSAGE "Copy records to another file" ;
ENABLED
MENUITEM "&Delete..." ;
RESOURCE "DEL" ;
ACTION MsgInfo( " oDbfWnd:DeleteFor() ");
MESSAGE "Delete all records matching a certain criteria" ;
ENABLED
MENUITEM "Reca&ll..." ;
ACTION MsgInfo( " oDbfWnd:RecallFor() ");
MESSAGE "Recall all records matching a certain criteria" ;
ENABLED
MENUITEM "R&eplace..." ;
ACTION MsgInfo( " oDbfWnd:ReplaceFor() ");
MESSAGE "Replace all records matching a certain criteria" ;
ENABLED
MENUITEM "S&cript process..." ;
RESOURCE "SCRIPT" ;
ACTION MsgInfo( " oDbfWnd:Script() ");
MESSAGE "Process a script file to all records matching a certain criteria" ;
ENABLED
MENUITEM "Pac&k" ;
ACTION MsgInfo( " oDbfWnd:Pack() ");
MESSAGE "Eliminate phisically deleted records" ;
ENABLED
MENUITEM "&Zap" ;
ACTION MsgInfo( " oDbfWnd:Zap() ");
MESSAGE "Delete every record in the database" ;
ENABLED
SEPARATOR
MENUITEM "&Oem to Ansi" ;
ACTION MsgInfo( " oDbfWnd:OtoA(.F.) ");
MESSAGE "Translate from OEM to ANSI" ;
ENABLED
MENUITEM "A&nsi to Oem" ;
ACTION MsgInfo( " oDbfWnd:OtoA(.T.) ");
MESSAGE "Translate from ANSI to OEM" ;
ENABLED
ENDMENU
MENUITEM "&Windows"
MENU
MENUITEM "&Cascade" ;
RESOURCE "CASCAWND" ;
MESSAGE OemToAnsi( "Organize windows on cascade" ) ;
ACTION oWndDbu:Cascade()
MENUITEM "&Vertical mosaic" ;
RESOURCE "MOSVRWND" ;
MESSAGE OemToAnsi( "Organize windows on vertical mosaic" ) ;
ACTION oWndDbu:Tile()
MENUITEM "&Horizontal mosaic" ;
RESOURCE "MOSHRWND" ;
ACTION oWndDbu:Tile( .t. );
MESSAGE OemToAnsi( "Organize windows on horizontal mosaic" )
MENUITEM "&Minimize Windows" ;
RESOURCE "MINIMWND" ;
ACTION oWndDbu:IconizeAll() ;
MESSAGE "Minimize all Windows"
MENUITEM "&Restore all windows" ;
RESOURCE "MAXIMWND" ;
ACTION Asend(oWndDbu:oWndClient:aWnd,'NORMAL') ;
MESSAGE "Restore all windows"
MENUITEM "C&lose windows" ;
RESOURCE "CLOSEWND" ;
ACTION oWndDbu:CloseAll() ;
MESSAGE "Close all windows"
MENUITEM "&Organize Icons" ;
MESSAGE OemToAnsi( "Organize minimized windows" ) ;
ACTION oWndDbu:ArrangeIcons()
ENDMENU
MENUITEM "&Help"
MENU
MENUITEM "&Index"+chr(9)+"F1" ;
RESOURCE "HELP" ;
ACTION MsgInfo( " HelpIndex() ");
MESSAGE "Shows the Help contents" ;
ENABLED
MENUITEM "&Using Help" ;
ACTION MsgInfo( " Winhelp.hlp") ;
MESSAGE "More information about using help" ;
ENABLED
MENUITEM "&Readme text file" ;
RESOURCE "NOTEPAD" ;
ACTION WinExec("Notepad readme.txt") ;
MESSAGE "Modifications and enhancements not present on the help file" ;
ENABLED
SEPARATOR
MENUITEM "&Web page (Internet)" ;
RESOURCE "INTERNET" ;
ACTION ShellExecute(oWnd:hWnd, "open", URLNAME) ;
MESSAGE "Web page on the Internet" ;
ENABLED
MENUITEM "&Send mail" ;
RESOURCE "MAIL" ;
ACTION MsgInfo(" SendMail() ") ;
MESSAGE "Contact with us via eMail" ;
ENABLED
MENUITEM "&Calculator" ;
RESOURCE "CALC" ;
ACTION WinExec("Calc.exe") ;
MESSAGE "Windows calculator" ;
ENABLED
SEPARATOR
MENUITEM "&About "+EXENAME ;
RESOURCE "INFO" ;
ACTION MsgAbout( "DBU for Windows", "(c) FiveTech Software 2011" ) ;
MESSAGE "More information about the program" ;
ENABLED
ENDMENU
ENDMENU
return oMenu
//----------------------------------------------------------------------------//
static function files2brw( nRow, nCol, aFiles )
local cFile
for each cFile in aFiles
if Upper( cFileExt( cFile ) ) == 'DBF'
File2Brw( cFile )
else
CheckBrwDrop( ClientToScreen( oWndDbu:hWnd, { nRow, nCol } ), cFile)
endif
next
return nil
//----------------------------------------------------------------------------//
static function file2brw( cFile )
local oWndChild, oBrw
local cAlias, cFileNoExt
if ! OpenFile( cFile, @cAlias, @cFileNoExt )
return nil
endif
DEFINE WINDOW oWndChild MDICHILD OF oWndDbu ;
TITLE cFileNoExt
@ 0,0 XBROWSE oBrw OF oWndChild ;
ALIAS cAlias ;
AUTOCOLS AUTOSORT FOOTERS LINES CELL NOBORDER
AEval( oBrw:aCols, { |oCol| oCol:cCol := oCol:cHeader } )
AEval( oBrw:aCols, { |oCol| oCol:cHeader := Upper( Left( oCol:cHeader, 1 ) ) + Lower( Substr( oCol:cHeader, 2 ) ) } )
oBrw:bPopUp := { |o| ColMenu( o ) }
oBrw:CreateFromCode()
oWndChild:oClient := oBrw
BrwBtnBar( oBrw )
SET MESSAGE OF oWndChild TO cFile 2007
ACTIVATE WINDOW oWndChild
TDbfWnd():New( oWndChild, oBrw )
return nil
//----------------------------------------------------------------------------//
static function CheckBrwDrop( aPoint, cFile )
local ownd, oBrw, nRow, nCol
local nColPos, nRowPos
if ( oWndDbu := oWndDbu:oWndActive ) != nil
oBrw := oWnd:oClient
if oBrw != nil .and. oBrw:IsKindOf( TXBrowse() )
aPoint := ScreenToClient( oBrw:hWnd, aPoint )
nRow := aPoint[ 1 ]
nCol := aPoint[ 2 ]
if oBrw:DropFile( nRow, nCol, cFile )
// MsgInfo( 'handled' )
else
msginfo( 'Not Valid File' )
endif
endif
endif
return nil
//----------------------------------------------------------------------------//
static function OpenFile( cFile, cAlias, cFileNoExt )
local lOpen := .f.
local cDriver := 'DBFCDX'
if Upper( cFileExt( cFile ) ) == 'DBF'
cFileNoExt := cFileNoExt( cFile )
cAlias := cGetNewAlias( Left( cFileNoExt, 4 ) )
TRY
dbUseArea( .t., cDriver, cFile, cAlias, .t., .f. )
CATCH
MsgInfo( cFile + CRLF + 'can not be opened' )
return .f.
END
lOpen := .t.
else
MsgInfo( 'Not a DBF File' )
endif
return lOpen
//----------------------------------------------------------------------------//
static function NewFile()
local cFile
if ! Empty( cFile := cGetFile( "DataFile (*.DBF)|*.dbf|", ;
"Select Data File to Browse",1, ;
"\fwh\samples" ) )
File2Brw( cFile )
endif
return nil
//----------------------------------------------------------------------------//
static function BrwbtnBar( oBrw )
local oBar, oBtn
DEFINE BUTTONBAR oBar OF oBrw:oWnd SIZE 56,64 3D 2007
DEFINE BUTTON OF oBar ;
RESOURCE "REPORT" TOP ;
PROMPT "Report" ;
MENU ReportMenu( oBrw ) ;
ACTION This:ShowPopUp() ;
MESSAGE "Print the browse contents" ;
TOOLTIP { "Print Report", "Report" }
DEFINE BUTTON OF oBar ;
RESOURCE "EXCEL" TOP ;
PROMPT "Excel" ;
ACTION This:ShowPopUp() ;
MENU ExcelMenu( oBrw ) ;
MESSAGE "Export browse contents to Excel" ;
TOOLTIP { "Export to Excel", "Excel" }
DEFINE BUTTON oBtn OF oBar ;
RESOURCE "CONFIG" TOP ;
PROMPT "Config" ;
MENU ConfigMenu( oBrw ) ;
ACTION This:ShowPopUp() ;
MESSAGE "Change background, Style2007, FastEdit option, etc" ;
TOOLTIP { "Configure", "SetUp",,CLR_BLUE,nRGB(220,230,247) }
DEFINE BUTTON OF oBar ;
RESOURCE 'CODE' TOP ;
PROMPT 'Source' ;
ACTION ViewCode( oBrw ) ; //MemoEdit( oBrw:PrgCode() ) ;
TOOLTIP 'Generate program source'
DEFINE BUTTON OF oBar ;
RESOURCE 'DLG' TOP ;
PROMPT 'Dialog' ;
ACTION SetBrwInDlg( oBrw ) ;
TOOLTIP 'View Browse in Dialog'
return oBar
//----------------------------------------------------------------------------//
static function SetBrwInDlg( oBrw )
local oWnd, oDlg
oWndDbu := oBrw:oWnd
DEFINE DIALOG oDlg SIZE 800,600 PIXEL TITLE oWnd:cTitle
ACTIVATE DIALOG oDlg ;
ON INIT InitBrwDlg( oBrw, oDlg ) ;
VALID ExitBrwDlg( oBrw, oWndDbu ) ;
ON RIGHT CLICK ( SetWindowLong( oBrw:hWnd, -20, ;
nXor( GetWindowLong( oBrw:hWnd, -20 ), 0x200 ) ) )
return nil
//----------------------------------------------------------------------------//
static function InitBrwDlg( oBrw, oDlg )
local oWndDbu := oBrw:oWnd
local nColsWidth := oBrw:GetDisplayColsWidth() + 24
oBrw:oWnd := oDlg
SetParent( oBrw:hWnd, oDlg:hWnd )
oBrw:nTop := 20
oBrw:nLeft := 20
oBrw:nHeight := oDlg:nHeight - 80
oBrw:nWidth := oDlg:nWidth - 40
if oBrw:nWidth > nColsWidth
oBrw:nWidth := nColsWidth
oDlg:nWidth := oBrw:nWidth + 40
endif
oBrw:Resize()
oDlg:Center()
oWnd:Hide()
return .f.
//----------------------------------------------------------------------------//
static function ExitBrwDlg( oBrw, oWndDbu )
oBrw:oWnd := oWnd
SetParent( oBrw:hWnd, oWnd:hWnd )
oWnd:oClient := oBrw
oWnd:Show()
oWnd:ReSize()
return .t.
//----------------------------------------------------------------------------//
static function ExcelMenu( oBrw )
local oPop
MENU oPop POPUP 2007
MENUITEM "Export to Excel" ACTION oBrw:ToExcel()
MENUITEM "Export to Excel with Group Totals" ;
WHEN ! Empty( oBrw:GetVisibleCols()[1]:cOrder ) ;
ACTION oBrw:ToExcel(,1)
ENDMENU
return oPop
//----------------------------------------------------------------------------//
static function ReportMenu( oBrw )
local oPop
MENU oPop POPUP 2007
MENUITEM "Simple Report" ACTION oBrw:Report()
MENUITEM "Report with Grouping" ;
WHEN ! Empty( oBrw:GetVisibleCols()[1]:cOrder ) ;
ACTION oBrw:Report( nil, .t., .t., nil, 1 )
ENDMENU
return oPop
//----------------------------------------------------------------------------//
static function ColMenu( ocol )
local oPop
MENU oPop POPUP 2007
MENUITEM "Align"
MENU
MENUITEM "Left Align" WHEN oCol:nDataStrAlign > 0 ;
ACTION ( oCol:SetAlign( AL_LEFT ), oCol:oBrw:SetFocus() )
MENUITEM "Center Align" WHEN oCol:nDataStrAlign != AL_CENTER ;
ACTION ( oCol:SetAlign( AL_CENTER ), oCol:oBrw:SetFocus() )
MENUITEM "Right Align" WHEN oCol:nDataStrAlign != AL_RIGHT ;
ACTION ( oCol:SetAlign( AL_RIGHT ), oCol:oBrw:SetFocus() )
ENDMENU
MENUITEM "Freeze" ACTION ( oCol:oBrw:nFreeze := oCol:nPos, oCol:oBrw:Refresh(), oCol:oBrw:SetFocus() )
MENUITEM "Stretch" ACTION ( oCol:oBrw:nStretchCol := oCol:nCreationOrder, oCol:oBrw:ReSize(), ;
oCol:oBrw:Refresh(), ;
oCol:oBrw:SetFocus() )
MENUITEM "Edit" ACTION ( oCol:nEditType := If( oCol:nEditType > 0, 0, 1 ), ;
oMenuItem:SetCheck( oCol:nEditType > 0 ) )
MENUITEM 'Inspect' ACTION XBrowse( oCol )
MENUITEM 'Rptcode' ACTION MsgInfo( oCol:RptCode() )
ENDMENU
return oPop
//----------------------------------------------------------------------------//
static function ConfigMenu( oBrw )
local oPop
MENU oPop POPUP 2007
MENUITEM "2007" CHECKED ;
ACTION ( oBrw:l2007 := !oBrw:l2007, oMenuItem:SetCheck( oBrw:l2007 ), ;
oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "FastEdit" ;
ACTION ( oBrw:lFastEdit := !oBrw:lFastEdit, oMenuItem:SetCheck( oBrw:lFastEdit ), ;
oBrw:SetFocus() )
MENUITEM "RecordSelector" CHECKED ;
ACTION ( oBrw:lRecordSelector := !oBrw:lRecordSelector, ;
oMenuItem:SetCheck( oBrw:lRecordSelector ), ;
oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "HScroll" CHECKED ;
ACTION ( oMenuItem:SetCheck( oBrw:SetHScroll( ! oBrw:lHScroll ) ) )
MENUITEM "Marquee"
MENU
MENUITEM "NoMarquee" ACTION ( oBrw:nMarqueeStyle := 0, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "DottedCell" ACTION ( oBrw:nMarqueeStyle := 1, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "SolidCell" ACTION ( oBrw:nMarqueeStyle := 2, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "HighL cell" ACTION ( oBrw:nMarqueeStyle := 3, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "HighL RowRC" ACTION ( oBrw:nMarqueeStyle := 4, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "HighL Row" ACTION ( oBrw:nMarqueeStyle := 5, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "HighL RowMS" ACTION ( oBrw:nMarqueeStyle := 6, oBrw:Refresh(), oBrw:SetFocus() )
ENDMENU
MENUITEM "Row LineStyle"
MENU
MENUITEM "No Lines" ACTION ( oBrw:nRowDividerStyle := 0, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Black" ACTION ( oBrw:nRowDividerStyle := 1, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Dark Gray" ACTION ( oBrw:nRowDividerStyle := 2, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "ForeColor" ACTION ( oBrw:nRowDividerStyle := 3, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Light Gray" ACTION ( oBrw:nRowDividerStyle := 4, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Inset" ACTION ( oBrw:nRowDividerStyle := 5, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Raised" ACTION ( oBrw:nRowDividerStyle := 6, oBrw:Refresh(), oBrw:SetFocus() )
ENDMENU
MENUITEM "Col LineStyle"
MENU
MENUITEM "No Lines" ACTION ( oBrw:nColDividerStyle := 0, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Black" ACTION ( oBrw:nColDividerStyle := 1, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Dark Gray" ACTION ( oBrw:nColDividerStyle := 2, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "ForeColor" ACTION ( oBrw:nColDividerStyle := 3, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Light Gray" ACTION ( oBrw:nColDividerStyle := 4, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Inset" ACTION ( oBrw:nColDividerStyle := 5, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Raised" ACTION ( oBrw:nColDividerStyle := 6, oBrw:Refresh(), oBrw:SetFocus() )
SEPARATOR
MENUITEM "ColDividerComplete" CHECKED ACTION ( ;
oBrw:lColDividerComplete := ! oBrw:lColDividerComplete, ;
oMenuItem:SetCheck( oBrw:lColDividerComplete ), ;
oBrw:Refresh(), oBrw:SetFocus() )
ENDMENU
MENUITEM "BackGround"
MENU
MENUITEM "None" ACTION ( oBrw:SetBackGround(), oBrw:SetFocus() )
SEPARATOR
MENUITEM "Paper" ACTION ( oBrw:SetBackGround( "PAPER" ), oBrw:SetFocus() )
MENUITEM "Stone" ACTION ( oBrw:SetBackGround( "STONE" ), oBrw:SetFocus() )
MENUITEM "FiveBack" ACTION ( oBrw:SetBackGround( "FIVEBACK" ), oBrw:SetFocus() )
SEPARATOR
MENUITEM "Select Image" ACTION SetBmpBack( oBrw )
MENUITEM "ImageMode"
MENU
MENUITEM "Tiled" WHEN ! Empty( oBrw:oBrush:hBitmap ) ;
ACTION ( oBrw:SetBackGround( , BCK_TILED ) )
MENUITEM "Stretch" WHEN ! Empty( oBrw:oBrush:hBitmap ) ;
ACTION ( oBrw:SetBackGround( , BCK_STRETCH ) )
MENUITEM "Fill" WHEN ! Empty( oBrw:oBrush:hBitmap ) ;
ACTION ( oBrw:SetBackGround( , BCK_FILL ) )
ENDMENU
ENDMENU
MENUITEM "Font" ACTION ( oBrw:SelFont(), oBrw:SetFocus() )
MENUITEM "Stretch"
MENU
MENUITEM "None" ACTION ( oBrw:nStretchCol := STRETCHCOL_NONE, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Last" ACTION ( oBrw:nStretchCol := STRETCHCOL_LAST, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Widest" ACTION ( oBrw:nStretchCol := STRETCHCOL_WIDEST, oBrw:Refresh(), oBrw:SetFocus() )
ENDMENU
MENUITEM "NoFreeze" WHEN ( oBrw:nFreeze > 0 ) ;
ACTION ( oBrw:nFreeze := 0, oBrw:Refresh(), oBrw:SetFocus() )
ENDMENU
return oPop
//----------------------------------------------------------------------------//
static function SetBmpBack( oBrw )
local cImage
if ! Empty( cImage := cGetFile( "Image File (*.bmp,jpg,png)|*.bmp;*.png;*.jpg|", ;
"Select Image file ", 1, ;
"\fwh\bitmaps" ) )
oBrw:SetBackGround( cImage )
endif
oBrw:SetFocus()
return nil
//----------------------------------------------------------------------------//
static function ViewCode( oBrw )
local aCode := Array( 4 )
local aGet := Array( 4 )
local oDlg, oFolder
local oFont
#define DLGWD 350 //250
#define DLGHT 250
aCode := oBrw:PrgCode()
DEFINE FONT oFont NAME 'LUCIDA CONSOLE' SIZE 0,-12
DEFINE DIALOG oDlg SIZE DLGWD*2, DLGHT*2 PIXEL ;
TITLE oBrw:oWnd:cTitle + " ( Source)" ;
FONT oWndDbu:oFont
@ 05,05 FOLDER oFolder ;
PROMPTS 'ListBox Style', 'CommandStyle', 'Oops Style', 'Report Code' ;
SIZE DLGWD - 10, DLGHT - 27 PIXEL ;
OF oDlg ; // ADJUST
FONT oWndDbu:oFont
@ 10,10 GET aGet[ 1 ] VAR aCode[ 1 ] TEXT ;
SIZE DLGWD-30,DLGHT-57 PIXEL ;
OF oFolder:aDialogs[ 1 ] ;
FONT oFont
@ 10,10 GET aGet[ 2 ] VAR aCode[ 2 ] TEXT ;
SIZE DLGWD-30,DLGHT-57 PIXEL ;
OF oFolder:aDialogs[ 2 ] ;
FONT oFont
@ 10,10 GET aGet[ 3 ] VAR aCode[ 3 ] TEXT ;
SIZE DLGWD-30,DLGHT-57 PIXEL ;
OF oFolder:aDialogs[ 3 ] ;
FONT oFont
@ 10,10 GET aGet[ 4 ] VAR aCode[ 4 ] TEXT ;
SIZE DLGWD-30,DLGHT-57 PIXEL ;
OF oFolder:aDialogs[ 4 ] ;
FONT oFont
@ DLGHT-20,05 BUTTONBMP BITMAP 'COPY3' SIZE 16,16 PIXEL OF oDlg ;
ACTION CopyToClip( aCode[ oFolder:nOption ] )
@ DLGHT-20,23 BUTTONBMP BITMAP 'SAVE2' SIZE 16,16 PIXEL OF oDlg ;
ACTION SaveCode( aCode[ oFolder:nOption ] )
@ DLGHT-20,41 BUTTONBMP BITMAP 'RUN' SIZE 16,16 PIXEL OF oDlg ;
ACTION CompileAndRun( aCode[ oFolder:nOption ] )
@ DLGHT-20,DLGWD-21 BUTTONBMP BITMAP 'CLOSE2' ;
SIZE 16,16 PIXEL OF oDlg ;
ACTION oDlg:End()
ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont
return nil
//----------------------------------------------------------------------------//
static function CopyToClip( cText )
local oClip
oClip := TClipBoard():New()
if oClip:Open()
oClip:SetText( cText )
oClip:Close()
endif
oClip:End()
return nil
//----------------------------------------------------------------------------//
static function SaveCode( cText )
local cFile
if ! Empty( cFile := cGetFile( "Prg File (*.PRG)|*.PRG|", ;
"Select PRG File to Save", ;
CurDir(), .t. ) )
if ! MemoWrit( cFile, cText )
MsgInfo( 'Write Failure' )
endif
endif
return nil
//----------------------------------------------------------------------------//
static function CompileAndRun( cText )
#ifdef __XHARBOUR__
MemoWrit( 'test_x.prg', cText )
WinExec( 'buildx.bat test_x' )
#else
MemoWrit( 'test_x.prg', cText )
WinExec( 'buildh.bat test_x' )
#endif
return nil
//----------------------------------------------------------------------------//
function dbfbuild()
local oDlg, oGet, oGet1, oType, oLen, oDec, oLbx, oBtnAdd, oBtnEdit
local cName := Space( 9 ) // Limit to 9 instead of 10 for TDatabase
local cType := "C"
local nLen := 10
local nDec := 0
local cField := Space( 20 )
local cTypes := "CNLDM"
local aLens := { 10, 10, 1, 8, 8 }
local cDbfName := Space( 12 )
local lEditing := .f.
cDbfName:= padr("TEST",12)
DEFINE DIALOG oDlg RESOURCE "DbfBuild" TITLE "FiveWin - DbfBuilder"
REDEFINE GET oGet VAR cName ID 110 OF oDlg picture "@!XXXXXXXXX"
REDEFINE COMBOBOX oType VAR cType ITEMS { "C", "N", "L", "D", "M" } ;
ON CHANGE ( nLen := aLens[ At( cType, cTypes ) ], oLen:Refresh() );
ID 120 OF oDlg
REDEFINE GET oLen VAR nLen PICTURE "9999" ID 130 OF oDlg
REDEFINE GET oDec VAR nDec PICTURE "9" ID 140 OF oDlg
REDEFINE BUTTON oBtnAdd ID 150 OF oDlg ;
ACTION (AddField( oLbx, oGet, oBtnAdd, oBtnEdit,;
@cName, cType, nLen, nDec, @lEditing ), oBtnAdd:oJump:= oGet, oDlg:refresh() )
REDEFINE BUTTON ID 160 OF oDlg ACTION oDlg:End()
REDEFINE LISTBOX oLbx VAR cField ID 170 OF oDlg
oLbx:blDblClick:={|| EditField( oBtnAdd, oBtnEdit,;
cField, @cName, @cType, @nLen, @nDec, @lEditing,;
oGet, oType, oLen, oDec )}
REDEFINE BUTTON oBtnEdit ID 180 OF oDlg ;
ACTION EditField( oBtnAdd, oBtnEdit,;
cField, @cName, @cType, @nLen, @nDec, @lEditing,;
oGet, oType, oLen, oDec )
REDEFINE BUTTON ID 190 OF oDlg ACTION oLbx:Del()
REDEFINE BUTTON ID 112 OF oDlg ACTION oLbx:swapUp()
REDEFINE BUTTON ID 113 OF oDlg action oLbx:swapDown()
REDEFINE BUTTON ID 111 OF oDlg ;
ACTION (cDbfName:=padr(cFileNoPath(OPEN(oLbx, cName)),12), oGet1:refresh() )
REDEFINE GET oGet1 var cDbfName ID 210 OF oDlg
REDEFINE BUTTON ID 220 OF oDlg ;
ACTION BuildDbf( trim(cDbfName), oLbx )
ACTIVATE DIALOG oDlg CENTERED ;
//on init import( cDbfName, oLbx )
return nil
//----------------------------------------------------------------------------//
static function AddField( oLbx, oGet, oBtnAdd, oBtnEdit,;
cName, cType, nLen, nDec, lEditing )
if Empty( cName )
MsgInfo( "I need a field name", "Sorry" )
else
if ! lEditing
oLbx:Add( xPadR( cName, 100 ) + cType + ;
xPadL( Str( nLen, 3 ), 50 ) + xPadL( Str( nDec, 1 ), 20 ),;
oLbx:GetPos() )
else
oLbx:Modify( xPadR( cName, 100 ) + cType + ;
xPadL( Str( nLen, 3 ), 50 ) + xPadL( Str( nDec, 1 ), 20 ) )
oBtnAdd:SetText( "&Add" )
oBtnEdit:Enable()
lEditing = .f.
endif
cName = Space( 10 )
oGet:Refresh()
oGet:SetFocus( .t. )
endif
return nil
//----------------------------------------------------------------------------//
static function BuildDbf( cDbfName, oLbx )
local aFields := {}
local n
local cTempFile:=""
if Empty( cDbfName )
MsgAlert( "I need a DBF name", "Sorry" )
return nil
endif
if Len( oLbx:aItems ) == 0
MsgAlert( "No fields defined", "Sorry" )
return nil
endif
if At( ".", cDbfName ) == 0
cDbfName += ".dbf"
endif
for n = 1 to Len( oLbx:aItems )
AAdd( aFields, _FieldInfo( AllTrim( oLbx:aItems[ n ] ) ) )
next
if File( cDbfName )
if MsgYesNo( "DBF already exists, update structure?", "Info" )
cTempFile:= tempFile("dbf")
DbCreate( cTempFile, aFields )
use (cTempFile)
append from (cDbfName)
use
ferase( cDbfName )
rename ( cTempFile ) to (cDbfName)
// Handle memo field(s)
// There is a problem when this file already exists--it doesn't get renamed for some reason.
if file( cFileNoExt( cTempFile ) +".dbt" )
//msgInfo( "memo file found")
//cOld := cFileNoExt(cTempFile)+".dbt"
//cNew := cFileNoExt( cDbfName )+".dbt"
//msgInfo( cOld, "cOld")
//msgInfo( cNew, "cNew")
rename ( cFileNoExt(cTempFile)+".dbt") to ( cFileNoExt( cDbfName )+".dbt")
//rename (cOld) to (cNew)
endif
return nil
endif
endif
DbCreate( cDbfName, aFields )
MsgInfo( "DBF created!", "AllRight" )
return nil
//----------------------------------------------------------------------------//
// Fixed function in dbfbuild.prg
static function _FieldInfo( cItem )
return { AllTrim( StrToken( cItem, 1 ) ),;
AllTrim( StrToken( cItem, 2 ) ),;
Val( StrToken( cItem, 3 ) ),;
Val( StrToken( cItem, 4 ) ) }
//----------------------------------------------------------------------------//
static function EditField( oBtnAdd, oBtnEdit, cField,;
cName, cType, nLen, nDec, lEditing,;
oName, oType, oLen, oDec )
if ! Empty( cField )
oBtnAdd:SetText( "&Replace" )
oBtnEdit:Disable()
lEditing = .t.
cName = padr(StrToken( cField, 1 ),9)
cType = StrToken( cField, 2 )
nLen = Val( StrToken( cField, 3 ) )
nDec = Val( StrToken( cField, 4 ) )
oName:Refresh()
oType:Refresh()
oLen:Refresh()
oDec:Refresh()
else
MsgInfo( "Select a field to edit", "Please" )
endif
return nil
//----------------------------------------------------------------------------//
static function import( cFile, oLbx )
local aStruct,i:=0
local cName,cType,nLen,nDec
cFile:= trim(cFile)
use (cFile)
aStruct := dbstruct()
for i:=1 to len( aStruct )
cName := aStruct[i,1]
cType := aStruct[i,2]
nLen := aStruct[i,3]
nDec := aStruct[i,4]
oLbx:Add( xPadR( cName, 100 ) + cType + ;
xPadL( Str( nLen, 3 ), 50 ) + xPadL( Str( nDec, 1 ), 20 ),;
oLbx:GetPos() )
next
use
return cName
//----------------------------------------------------------------------------//
STATIC FUNCTION OPEN(oLbx)
local cFile
local cFileMask := "Database (DBF) | *.dbf |"
local cInitialDirectory
local lSave:= .f.
local lLongNames:= .t.
cFile:= cGetFile32( cFileMask, , , cInitialDirectory, lSave, lLongNames )
if ! empty(cFile)
import( cFile, oLbx )
endif
return cFile
// Returns an unused filename with cExtension.
// cPath is optional. Defaults to current directory.
FUNCTION tempFile(cExtension,cPath)
local cFile
default cPath:=""
cExtension:= strtran(cExtension,".","")
// loop until you find a name that doesn't exist
do while .t.
cFile:="AAA"+trim(str(seconds(),5,0))+"."+upper(cExtension)
cFile:=strtran(cFile," ","0") // fix for hours between 00:00 & 01:00
cFile:= cPath + cFile
if .not. file( cFile )
exit
endif
enddo
return cPath + cFile
CLASS TDbfWnd
DATA oBrowse, oWnd
DATA cAlias
DATA lExclusive INIT .F.
METHOD New( oWndChild, oBrw )
METHOD DelRec()
METHOD EditRec()
METHOD AppRec()
METHOD Refresh() INLINE ::oBrowse:Refresh()
ENDCLASS
METHOD New( oWndChild, oBrw ) CLASS TDbfWnd
::oWnd = oWndChild
::oBrowse = oBrw
::oWnd:Cargo = Self
::oWnd:bGotFocus = { || oDbfWnd := ::oWnd:Cargo }
::cAlias = Alias()
oDbfWnd = Self
return Self
METHOD DelRec() CLASS TDbfWnd
/*
IF ! ::oItemDelReg:lActive
::oBrowse:Setfocus()
RETU NIL
ENDIF
*/
Select(::cAlias)
IF ! ::lExclusive
IF !(::cAlias)->(DbRLock())
MsgRun({|| SysWait(1) }, "Record lock error")
RETU NIL
ENDIF
ENDIF
IF Deleted()
DbRecall()
ELSE
DbDelete()
ENDIF
IF ! ::lExclusive
( ::cAlias )->( DbUnlock() )
ENDIF
IF Set( _SET_DELETED )
DO WHILE Deleted() .AND. !Bof()
DbSkip( -1 )
ENDDO
::Refresh()
ENDIF
// SayInfo(Self)
::oBrowse:Setfocus()
return nil
//----------------------------------------------------------------------------//
METHOD EditRec() CLASS TDbfWnd
MsgInfo( " EditRec ")
RETURN NIL
//----------------------------------------------------------------------------//
METHOD AppRec() CLASS TDbfWnd
// LOCAL cIndex := ::cIndex
Select(::cAlias)
APPEND BLANK
IF NetErr()
MsgRun({|| SysWait(1) },;
"Record append error")
RETU NIL
ENDIF
// ::cIndex := "<None> "
// ::ChangeOrder()
::oBrowse:GoBottom()
// ::EditFld()
RETURN NIL
//----------------------------------------------------------------------------//
#include 'fivewin.ch'
#include 'xbrowse.ch'
REQUEST DBFCDX
#DEFINE EXENAME "xWDBU"
static oWndDbu, oDbfWnd
//----------------------------------------------------------------------------//
function Main()
local oBrw, oFont
SetBalloon( .t. )
xbrNumformat( ,.t. )
SET XBROWSE TO TXBrCode()
DEFINE FONT oFont NAME 'TAHOMA' SIZE 0,-12
DEFINE WINDOW oWndDbu MDI ;
TITLE 'DBU for Windows' ;
MENU MainMenu()
oWndDbu:SetFont( oFont )
// MakeBar( oWndDbu )
// oWnd:oBar:cToolTip := { || "My Color" }
SET MESSAGE OF oWndDbu TO 'Developed with Harbour and FWH (FiveWin for Harbour/xHarbour)' 2007 DATE CLOCK KEYBOARD
ACTIVATE WINDOW oWndDbu MAXIMIZED ;
ON DROPFILES Files2Brw( nRow, nCol, aFiles )
return nil
//----------------------------------------------------------------------------//
INIT PROCEDURE PrgInit
SET DELETED ON
SET EXCLUSIVE OFF
SET DATE ITALIAN
SET CENTURY ON
RDDSetDefault( 'DBFCDX' )
return
//----------------------------------------------------------------------------//
static function MakeBar( oWndDbu )
local oBar
DEFINE BUTTONBAR oBar OF oWndDbu SIZE 56,64 2007
DEFINE BUTTON OF oBar PROMPT 'Open Data' ;
RESOURCE 'Open' ;
ACTION NewFile()
DEFINE BUTTON OF oBar PROMPT 'dbfbuild' ;
RESOURCE 'Open' ;
ACTION dbfbuild()
return oBar
//----------------------------------------------------------------------------//
static function MainMenu()
local oMenu, URLNAME := "http://www.fivetechsoft.com"
MENU oMenu 2007
MENUITEM "File"
MENU
MENUITEM "&New"+chr(9)+"Ctrl+U" ;
RESOURCE "NEW" ;
ACTION NewFile(dbfbuild()) ; //MsgInfo( "Fbrowse(DbfBuild(),.t.) ") ;
MESSAGE "Create new file" ;
ACCELERATOR ACC_CONTROL, asc("U") ;
ENABLED
MENUITEM "&Open"+chr(9)+"Ctrl+A" ;
RESOURCE "OPEN" ;
ACTION NewFile() ;
MESSAGE "Open file" ;
ACCELERATOR ACC_CONTROL, asc("A") ;
ENABLED
MENUITEM "C&lose"+chr(9)+"Ctrl+E" ;
RESOURCE "SAVE" ;
ACTION oWndDbu:oWnd:End() ;
MESSAGE "Close file" ;
ACCELERATOR ACC_CONTROL, asc("E") ;
ENABLED
MENUITEM "&Print"+chr(9)+"Ctrl+T" ;
RESOURCE "PRINTER" ;
ACTION MsgInfo( " oDbfWnd:Report() ") ;
MESSAGE "Print file" ;
ACCELERATOR ACC_CONTROL, asc("T") ;
ENABLED
MENUITEM "Command &Interpreter" ;
RESOURCE "DOT" ;
ACTION MsgInfo( " DotNew() ");
MESSAGE "Invokes the command interpreter" ;
ENABLED
MENUITEM "&Modify structure"+chr(9)+"Ctrl+M" ;
RESOURCE "DESIGN" ;
ACTION NewFile(dbfbuild()) ;
MESSAGE "Modify file structure" ;
ACCELERATOR ACC_CONTROL, asc("M") ;
ENABLED
MENUITEM "Multi-&file operation" ;
RESOURCE "MULTFILE" ;
ACTION MsgInfo( " MultiFile() ");
MESSAGE "&Multi-file operation" ;
ENABLED
MENUITEM "Import from ODBC database" ;
RESOURCE "IMPORT" ;
ACTION MsgInfo( " ImportODBC(oWnd) ");
MESSAGE "Import data from a ODBC database" ;
ENABLED
MENUITEM "&Configuration" ;
RESOURCE "CONFIG" ;
ACTION MsgInfo( " AppConfig() ");
MESSAGE "Program configuration" ;
ENABLED
SEPARATOR
MENUITEM "Specif&y printer" ;
RESOURCE "PROPERTY" ;
ACTION PrinterSetup() ;
MESSAGE "Printer configuration" ;
ENABLED
MENUITEM "&Map Network Drive" ;
RESOURCE "NETCONNE" ;
ACTION MsgInfo(" WNetConnectDialog() ") ;
MESSAGE "Connect to a network drive" ;
ENABLED
MENUITEM "&Disconnect Network Drive" ;
RESOURCE "NETDISCO" ;
ACTION MsgInfo(" WNetDisconnect() ") ;
MESSAGE "Disconnect from a network drive" ;
ENABLED
MENUITEM "&Exit"+chr(9)+"Alt+F4" ;
RESOURCE "EXIT" ;
ACTION oWndDbu:End() ;
MESSAGE "Exit from the application" ;
ENABLED
ENDMENU
MENUITEM "&Edit"
MENU
MENUITEM "&Copy record"+chr(9)+"Ctrl+C" ;
RESOURCE "COPY" ;
ACTION MsgInfo( " oDbfWnd:CopyRec() ") ;
MESSAGE "Copy record to the Clipboard" ;
ACCELERATOR ACC_CONTROL, asc("C") ;
ENABLED
MENUITEM "&Paste record"+chr(9)+"Ctrl+V" ;
RESOURCE "PASTE" ;
ACTION MsgInfo( " oDbfWnd:PasteRec() ");
MESSAGE "Paste record from the Clipboard" ;
ACCELERATOR ACC_CONTROL, asc("V")
SEPARATOR
MENUITEM "&Insert record"+chr(9)+"Ctrl+Insert" ;
RESOURCE "NEW" ;
ACTION oDbfWnd:AppRec();
MESSAGE "Append record" ;
ACCELERATOR ACC_CONTROL, VK_INSERT ;
ENABLED
MENUITEM "&Del/Recall record"+chr(9)+"Ctrl+Del" ;
RESOURCE "DEL" ;
ACTION oDbfWnd:DelRec() ;
MESSAGE "Del actual record" ;
ACCELERATOR ACC_CONTROL, VK_DELETE ;
ENABLED
MENUITEM "&Edit field"+chr(9)+"Enter" ;
RESOURCE "TEXTBOX" ;
ACTION MsgInfo( " oDbfWnd:EditFld() ");
MESSAGE "Edit actual record field" ;
ENABLED
//ACCELERATOR ACC_SHIFT, VK_RETURN ;
MENUITEM "&Edit record"+chr(9)+"CTRL+Enter" ;
RESOURCE "EDIT" ;
ACTION oDbfWnd:EditRec();
MESSAGE "Edit actual record (all fields)" ;
ENABLED
//ACCELERATOR ACC_CONTROL, VK_RETURN ;
ENDMENU
MENUITEM "&Navigation"
MENU
MENUITEM "&Search"+chr(9)+"Ctrl+S" ;
RESOURCE "SEARCH" ;
ACTION MsgInfo( " oDbfWnd:Seek() ");
MESSAGE "Search records using the active index" ;
ACCELERATOR ACC_CONTROL, asc("S") ;
ENABLED
MENUITEM "&Go to"+chr(9)+"Ctrl+G" ;
ACTION MsgInfo( " oDbfWnd:Ira() ");
MESSAGE "Jump to a record by its Recno()" ;
ACCELERATOR ACC_CONTROL, asc("G") ;
ENABLED
MENUITEM "S&kip"+chr(9)+"Ctrl+K" ;
ACTION MsgInfo( " oDbfWnd:Skip() ");
MESSAGE "Skip records" ;
ACCELERATOR ACC_CONTROL, asc("K") ;
ENABLED
SEPARATOR
MENUITEM "&Locate"+chr(9)+"F3" ;
ACTION MsgInfo( " oDbfWnd:Locate() ");
MESSAGE "Locate record" ;
ACCELERATOR ACC_NORMAL, VK_F3 ;
ENABLED
MENUITEM "&Continue"+chr(9)+"F4" ;
ACTION MsgInfo( " oDbfWnd:Locate(.T.)") ;
MESSAGE "Locate next record" ;
ACCELERATOR ACC_NORMAL, VK_F4 ;
ENABLED
ENDMENU
MENUITEM "&Indexes"
MENU
MENUITEM OemtoAnsi("&Open Index"+chr(9)+"Ctrl+X") ;
RESOURCE "OPEN" ;
ACTION MsgInfo( " oDbfWnd:OpenIndex() ");
MESSAGE "Select an index file" ;
ACCELERATOR ACC_CONTROL, asc("X") ;
ENABLED
MENUITEM OemtoAnsi("&Close Index"+chr(9)+"Ctrl+L") ;
RESOURCE "SAVE" ;
ACTION MsgInfo( " oDbfWnd:CloseIndex()") ;
MESSAGE "Close current index file" ;
ACCELERATOR ACC_CONTROL, asc("L") ;
ENABLED
MENUITEM "&Previous order"+chr(9)+"Ctrl+P" ;
RESOURCE "PREV" ;
ACTION MsgInfo( " oDbfWnd:PrevOrder()");
MESSAGE "Go to previous order" ;
ACCELERATOR ACC_CONTROL, asc("P") ;
ENABLED
MENUITEM "&Next order"+chr(9)+"Ctrl+N" ;
RESOURCE "NEXT" ;
ACTION MsgInfo( " oDbfWnd:NextOrder() ");
MESSAGE "Go to next order" ;
ACCELERATOR ACC_CONTROL, asc("N") ;
ENABLED
MENUITEM OemtoAnsi("&Filter by scope"+chr(9)+"Ctrl+F") ;
RESOURCE "FILTER" ;
ACTION MsgInfo( " oDbfWnd:Scope() ");
MESSAGE "Set a scope to filter records, based on the active index" ;
ACCELERATOR ACC_CONTROL, asc("F") ;
ENABLED
MENUITEM OemtoAnsi("&Create new index"+chr(9)+"Ctrl+W") ;
RESOURCE "INDEX" ;
ACTION MsgInfo( " oDbfWnd:BuildIndex() ");
MESSAGE "Create a new index file or Tag" ;
ACCELERATOR ACC_CONTROL, asc("W") ;
ENABLED
SEPARATOR
MENUITEM "&Delete Order" ;
RESOURCE "DEL" ;
ACTION MsgInfo( " oDbfWnd:DelTag() ");
MESSAGE "Delete current Order (Tag)" ;
ENABLED
MENUITEM "&Reindex"+chr(9)+"Ctrl+R" ;
RESOURCE "REPEAT" ;
ACTION MsgInfo( " oDbfWnd:Reindex() ");
MESSAGE "Reindex all the open indexes" ;
ACCELERATOR ACC_CONTROL, asc("R") ;
ENABLED
ENDMENU
MENUITEM "&Utilities"
MENU
MENUITEM "&More information"+chr(9)+"Ctrl+I" ;
RESOURCE "PROPERTY" ;
ACTION MsgInfo( " oDbfWnd:Info() ");
MESSAGE "Show additional information about the current file" ;
ACCELERATOR ACC_CONTROL, asc("I") ;
ENABLED
MENUITEM "&Browse Columns"+chr(9)+"Ctrl+B" ;
RESOURCE "TBROWSE" ;
ACTION MsgInfo( " oDbfWnd:SetColumn() ");
MESSAGE "Columns configuration" ;
ACCELERATOR ACC_CONTROL, asc("B") ;
ENABLED
MENUITEM "&Relations" ;
RESOURCE "CHAIN" ;
ACTION MsgInfo( " oDbfWnd:Relations() ");
MESSAGE "Establish relations with other databases" ;
ENABLED
MENUITEM "Establish &Filter" ;
RESOURCE "FILTER" ;
ACTION MsgInfo( " oDbfWnd:Filter() ");
MESSAGE "Set the criteria by which to filter records" ;
ENABLED
MENUITEM "Coun&t" ;
ACTION MsgInfo( " oDbfWnd:Count() ");
MESSAGE "Count the number of records meeting a certain criteria" ;
ENABLED
MENUITEM "&Statistics" ;
RESOURCE "STATICS" ;
ACTION MsgInfo( " oDbfWnd:Sum() ");
MESSAGE "Statistics calculations of all numeric fields" ;
ENABLED
MENUITEM "&Graphics" ;
RESOURCE "GRAPH" ;
ACTION MsgInfo( " oDbfWnd:Graphics() ");
MESSAGE "Graphics based on current data file" ;
ENABLED
SEPARATOR
MENUITEM "&Append from..." ;
RESOURCE "IMPORT" ;
ACTION MsgInfo( " oDbfWnd:AppendFrom() ");
MESSAGE "Append records from another file" ;
ENABLED
MENUITEM "&Copy to..." ;
RESOURCE "COPY" ;
ACTION MsgInfo( " oDbfWnd:CopyTo() ");
MESSAGE "Copy records to another file" ;
ENABLED
MENUITEM "&Delete..." ;
RESOURCE "DEL" ;
ACTION MsgInfo( " oDbfWnd:DeleteFor() ");
MESSAGE "Delete all records matching a certain criteria" ;
ENABLED
MENUITEM "Reca&ll..." ;
ACTION MsgInfo( " oDbfWnd:RecallFor() ");
MESSAGE "Recall all records matching a certain criteria" ;
ENABLED
MENUITEM "R&eplace..." ;
ACTION MsgInfo( " oDbfWnd:ReplaceFor() ");
MESSAGE "Replace all records matching a certain criteria" ;
ENABLED
MENUITEM "S&cript process..." ;
RESOURCE "SCRIPT" ;
ACTION MsgInfo( " oDbfWnd:Script() ");
MESSAGE "Process a script file to all records matching a certain criteria" ;
ENABLED
MENUITEM "Pac&k" ;
ACTION MsgInfo( " oDbfWnd:Pack() ");
MESSAGE "Eliminate phisically deleted records" ;
ENABLED
MENUITEM "&Zap" ;
ACTION MsgInfo( " oDbfWnd:Zap() ");
MESSAGE "Delete every record in the database" ;
ENABLED
SEPARATOR
MENUITEM "&Oem to Ansi" ;
ACTION MsgInfo( " oDbfWnd:OtoA(.F.) ");
MESSAGE "Translate from OEM to ANSI" ;
ENABLED
MENUITEM "A&nsi to Oem" ;
ACTION MsgInfo( " oDbfWnd:OtoA(.T.) ");
MESSAGE "Translate from ANSI to OEM" ;
ENABLED
ENDMENU
MENUITEM "&Windows"
MENU
MENUITEM "&Cascade" ;
RESOURCE "CASCAWND" ;
MESSAGE OemToAnsi( "Organize windows on cascade" ) ;
ACTION oWndDbu:Cascade()
MENUITEM "&Vertical mosaic" ;
RESOURCE "MOSVRWND" ;
MESSAGE OemToAnsi( "Organize windows on vertical mosaic" ) ;
ACTION oWndDbu:Tile()
MENUITEM "&Horizontal mosaic" ;
RESOURCE "MOSHRWND" ;
ACTION oWndDbu:Tile( .t. );
MESSAGE OemToAnsi( "Organize windows on horizontal mosaic" )
MENUITEM "&Minimize Windows" ;
RESOURCE "MINIMWND" ;
ACTION oWndDbu:IconizeAll() ;
MESSAGE "Minimize all Windows"
MENUITEM "&Restore all windows" ;
RESOURCE "MAXIMWND" ;
ACTION Asend( oWndDbu:oWndClient:aWnd,'NORMAL') ;
MESSAGE "Restore all windows"
MENUITEM "C&lose windows" ;
RESOURCE "CLOSEWND" ;
ACTION oWndDbu:CloseAll() ;
MESSAGE "Close all windows"
MENUITEM "&Organize Icons" ;
MESSAGE OemToAnsi( "Organize minimized windows" ) ;
ACTION oWndDbu:ArrangeIcons()
ENDMENU
MENUITEM "&Help"
MENU
MENUITEM "&Index"+chr(9)+"F1" ;
RESOURCE "HELP" ;
ACTION MsgInfo( " HelpIndex() ");
MESSAGE "Shows the Help contents" ;
ENABLED
MENUITEM "&Using Help" ;
ACTION MsgInfo( " Winhelp.hlp") ;
MESSAGE "More information about using help" ;
ENABLED
MENUITEM "&Readme text file" ;
RESOURCE "NOTEPAD" ;
ACTION WinExec("Notepad readme.txt") ;
MESSAGE "Modifications and enhancements not present on the help file" ;
ENABLED
SEPARATOR
MENUITEM "&Web page (Internet)" ;
RESOURCE "INTERNET" ;
ACTION ShellExecute(oWnd:hWnd, "open", URLNAME) ;
MESSAGE "Web page on the Internet" ;
ENABLED
MENUITEM "&Send mail" ;
RESOURCE "MAIL" ;
ACTION MsgInfo(" SendMail() ") ;
MESSAGE "Contact with us via eMail" ;
ENABLED
MENUITEM "&Calculator" ;
RESOURCE "CALC" ;
ACTION WinExec("Calc.exe") ;
MESSAGE "Windows calculator" ;
ENABLED
SEPARATOR
MENUITEM "&About "+EXENAME ;
RESOURCE "INFO" ;
ACTION MsgAbout( "DBU for Windows", "(c) FiveTech Software 2011" ) ;
MESSAGE "More information about the program" ;
ENABLED
ENDMENU
ENDMENU
return oMenu
//----------------------------------------------------------------------------//
static function files2brw( nRow, nCol, aFiles )
local cFile
for each cFile in aFiles
if Upper( cFileExt( cFile ) ) == 'DBF'
File2Brw( cFile )
else
CheckBrwDrop( ClientToScreen( oWndDbu:hWnd, { nRow, nCol } ), cFile)
endif
next
return nil
//----------------------------------------------------------------------------//
static function file2brw( cFile )
local oWndChild, oBrw
local cAlias, cFileNoExt
if ! OpenFile( cFile, @cAlias, @cFileNoExt )
return nil
endif
DEFINE WINDOW oWndChild MDICHILD OF oWndDbu ;
TITLE cFileNoExt
@ 0,0 XBROWSE oBrw OF oWndChild ;
ALIAS cAlias ;
AUTOCOLS AUTOSORT FOOTERS LINES CELL NOBORDER
AEval( oBrw:aCols, { |oCol| oCol:cCol := oCol:cHeader } )
AEval( oBrw:aCols, { |oCol| oCol:cHeader := Upper( Left( oCol:cHeader, 1 ) ) + Lower( Substr( oCol:cHeader, 2 ) ) } )
oBrw:bPopUp := { |o| ColMenu( o ) }
oBrw:CreateFromCode()
oWndChild:oClient := oBrw
BrwBtnBar( oBrw )
SET MESSAGE OF oWndChild TO cFile 2007
ACTIVATE WINDOW oWndChild
TDbfWnd():New( oWndChild, oBrw )
return nil
//----------------------------------------------------------------------------//
static function CheckBrwDrop( aPoint, cFile )
local ownd, oBrw, nRow, nCol
local nColPos, nRowPos
if ( oDbfWnd := oWndDbu:oWndActive ) != nil
oBrw := oWnd:oClient
if oBrw != nil .and. oBrw:IsKindOf( TXBrowse() )
aPoint := ScreenToClient( oBrw:hWnd, aPoint )
nRow := aPoint[ 1 ]
nCol := aPoint[ 2 ]
if oBrw:DropFile( nRow, nCol, cFile )
// MsgInfo( 'handled' )
else
msginfo( 'Not Valid File' )
endif
endif
endif
return nil
//----------------------------------------------------------------------------//
static function OpenFile( cFile, cAlias, cFileNoExt )
local lOpen := .f.
local cDriver := 'DBFCDX'
if Upper( cFileExt( cFile ) ) == 'DBF'
cFileNoExt := cFileNoExt( cFile )
cAlias := cGetNewAlias( Left( cFileNoExt, 4 ) )
TRY
dbUseArea( .t., cDriver, cFile, cAlias, .t., .f. )
CATCH
MsgInfo( cFile + CRLF + 'can not be opened' )
return .f.
END
lOpen := .t.
else
MsgInfo( 'Not a DBF File' )
endif
return lOpen
//----------------------------------------------------------------------------//
static function NewFile()
local cFile
if ! Empty( cFile := cGetFile( "DataFile (*.DBF)|*.dbf|", ;
"Select Data File to Browse",1, ;
"\fwh\samples" ) )
File2Brw( cFile )
endif
return nil
//----------------------------------------------------------------------------//
static function BrwbtnBar( oBrw )
local oBar, oBtn
DEFINE BUTTONBAR oBar OF oBrw:oWnd SIZE 56,64 3D 2007
DEFINE BUTTON OF oBar ;
RESOURCE "REPORT" TOP ;
PROMPT "Report" ;
MENU ReportMenu( oBrw ) ;
ACTION This:ShowPopUp() ;
MESSAGE "Print the browse contents" ;
TOOLTIP { "Print Report", "Report" }
DEFINE BUTTON OF oBar ;
RESOURCE "EXCEL" TOP ;
PROMPT "Excel" ;
ACTION This:ShowPopUp() ;
MENU ExcelMenu( oBrw ) ;
MESSAGE "Export browse contents to Excel" ;
TOOLTIP { "Export to Excel", "Excel" }
DEFINE BUTTON oBtn OF oBar ;
RESOURCE "CONFIG" TOP ;
PROMPT "Config" ;
MENU ConfigMenu( oBrw ) ;
ACTION This:ShowPopUp() ;
MESSAGE "Change background, Style2007, FastEdit option, etc" ;
TOOLTIP { "Configure", "SetUp",,CLR_BLUE,nRGB(220,230,247) }
DEFINE BUTTON OF oBar ;
RESOURCE 'CODE' TOP ;
PROMPT 'Source' ;
ACTION ViewCode( oBrw ) ; //MemoEdit( oBrw:PrgCode() ) ;
TOOLTIP 'Generate program source'
DEFINE BUTTON OF oBar ;
RESOURCE 'DLG' TOP ;
PROMPT 'Dialog' ;
ACTION SetBrwInDlg( oBrw ) ;
TOOLTIP 'View Browse in Dialog'
return oBar
//----------------------------------------------------------------------------//
static function SetBrwInDlg( oBrw )
local oDlg
oDbfWnd = oBrw:oWnd
DEFINE DIALOG oDlg SIZE 800,600 PIXEL TITLE oDbfWnd:cTitle
ACTIVATE DIALOG oDlg ;
ON INIT InitBrwDlg( oBrw, oDlg ) ;
VALID ExitBrwDlg( oBrw, oDbfWnd ) ;
ON RIGHT CLICK ( SetWindowLong( oBrw:hWnd, -20, ;
nXor( GetWindowLong( oBrw:hWnd, -20 ), 0x200 ) ) )
return nil
//----------------------------------------------------------------------------//
static function InitBrwDlg( oBrw, oDlg )
local oDbfWnd := oBrw:oWnd
local nColsWidth := oBrw:GetDisplayColsWidth() + 24
oBrw:oWnd := oDlg
SetParent( oBrw:hWnd, oDlg:hWnd )
oBrw:nTop := 20
oBrw:nLeft := 20
oBrw:nHeight := oDlg:nHeight - 80
oBrw:nWidth := oDlg:nWidth - 40
if oBrw:nWidth > nColsWidth
oBrw:nWidth := nColsWidth
oDlg:nWidth := oBrw:nWidth + 40
endif
oBrw:Resize()
oDlg:Center()
oDbfWnd:Hide()
return .f.
//----------------------------------------------------------------------------//
static function ExitBrwDlg( oBrw, oWnd )
oBrw:oWnd := oWnd
SetParent( oBrw:hWnd, oWnd:hWnd )
oWnd:oClient := oBrw
oWnd:Show()
oWnd:ReSize()
return .t.
//----------------------------------------------------------------------------//
static function ExcelMenu( oBrw )
local oPop
MENU oPop POPUP 2007
MENUITEM "Export to Excel" ACTION oBrw:ToExcel()
MENUITEM "Export to Excel with Group Totals" ;
WHEN ! Empty( oBrw:GetVisibleCols()[1]:cOrder ) ;
ACTION oBrw:ToExcel(,1)
ENDMENU
return oPop
//----------------------------------------------------------------------------//
static function ReportMenu( oBrw )
local oPop
MENU oPop POPUP 2007
MENUITEM "Simple Report" ACTION oBrw:Report()
MENUITEM "Report with Grouping" ;
WHEN ! Empty( oBrw:GetVisibleCols()[1]:cOrder ) ;
ACTION oBrw:Report( nil, .t., .t., nil, 1 )
ENDMENU
return oPop
//----------------------------------------------------------------------------//
static function ColMenu( ocol )
local oPop
MENU oPop POPUP 2007
MENUITEM "Align"
MENU
MENUITEM "Left Align" WHEN oCol:nDataStrAlign > 0 ;
ACTION ( oCol:SetAlign( AL_LEFT ), oCol:oBrw:SetFocus() )
MENUITEM "Center Align" WHEN oCol:nDataStrAlign != AL_CENTER ;
ACTION ( oCol:SetAlign( AL_CENTER ), oCol:oBrw:SetFocus() )
MENUITEM "Right Align" WHEN oCol:nDataStrAlign != AL_RIGHT ;
ACTION ( oCol:SetAlign( AL_RIGHT ), oCol:oBrw:SetFocus() )
ENDMENU
MENUITEM "Freeze" ACTION ( oCol:oBrw:nFreeze := oCol:nPos, oCol:oBrw:Refresh(), oCol:oBrw:SetFocus() )
MENUITEM "Stretch" ACTION ( oCol:oBrw:nStretchCol := oCol:nCreationOrder, oCol:oBrw:ReSize(), ;
oCol:oBrw:Refresh(), ;
oCol:oBrw:SetFocus() )
MENUITEM "Edit" ACTION ( oCol:nEditType := If( oCol:nEditType > 0, 0, 1 ), ;
oMenuItem:SetCheck( oCol:nEditType > 0 ) )
MENUITEM 'Inspect' ACTION XBrowse( oCol )
MENUITEM 'Rptcode' ACTION MsgInfo( oCol:RptCode() )
ENDMENU
return oPop
//----------------------------------------------------------------------------//
static function ConfigMenu( oBrw )
local oPop
MENU oPop POPUP 2007
MENUITEM "2007" CHECKED ;
ACTION ( oBrw:l2007 := !oBrw:l2007, oMenuItem:SetCheck( oBrw:l2007 ), ;
oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "FastEdit" ;
ACTION ( oBrw:lFastEdit := !oBrw:lFastEdit, oMenuItem:SetCheck( oBrw:lFastEdit ), ;
oBrw:SetFocus() )
MENUITEM "RecordSelector" CHECKED ;
ACTION ( oBrw:lRecordSelector := !oBrw:lRecordSelector, ;
oMenuItem:SetCheck( oBrw:lRecordSelector ), ;
oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "HScroll" CHECKED ;
ACTION ( oMenuItem:SetCheck( oBrw:SetHScroll( ! oBrw:lHScroll ) ) )
MENUITEM "Marquee"
MENU
MENUITEM "NoMarquee" ACTION ( oBrw:nMarqueeStyle := 0, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "DottedCell" ACTION ( oBrw:nMarqueeStyle := 1, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "SolidCell" ACTION ( oBrw:nMarqueeStyle := 2, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "HighL cell" ACTION ( oBrw:nMarqueeStyle := 3, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "HighL RowRC" ACTION ( oBrw:nMarqueeStyle := 4, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "HighL Row" ACTION ( oBrw:nMarqueeStyle := 5, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "HighL RowMS" ACTION ( oBrw:nMarqueeStyle := 6, oBrw:Refresh(), oBrw:SetFocus() )
ENDMENU
MENUITEM "Row LineStyle"
MENU
MENUITEM "No Lines" ACTION ( oBrw:nRowDividerStyle := 0, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Black" ACTION ( oBrw:nRowDividerStyle := 1, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Dark Gray" ACTION ( oBrw:nRowDividerStyle := 2, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "ForeColor" ACTION ( oBrw:nRowDividerStyle := 3, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Light Gray" ACTION ( oBrw:nRowDividerStyle := 4, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Inset" ACTION ( oBrw:nRowDividerStyle := 5, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Raised" ACTION ( oBrw:nRowDividerStyle := 6, oBrw:Refresh(), oBrw:SetFocus() )
ENDMENU
MENUITEM "Col LineStyle"
MENU
MENUITEM "No Lines" ACTION ( oBrw:nColDividerStyle := 0, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Black" ACTION ( oBrw:nColDividerStyle := 1, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Dark Gray" ACTION ( oBrw:nColDividerStyle := 2, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "ForeColor" ACTION ( oBrw:nColDividerStyle := 3, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Light Gray" ACTION ( oBrw:nColDividerStyle := 4, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Inset" ACTION ( oBrw:nColDividerStyle := 5, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Raised" ACTION ( oBrw:nColDividerStyle := 6, oBrw:Refresh(), oBrw:SetFocus() )
SEPARATOR
MENUITEM "ColDividerComplete" CHECKED ACTION ( ;
oBrw:lColDividerComplete := ! oBrw:lColDividerComplete, ;
oMenuItem:SetCheck( oBrw:lColDividerComplete ), ;
oBrw:Refresh(), oBrw:SetFocus() )
ENDMENU
MENUITEM "BackGround"
MENU
MENUITEM "None" ACTION ( oBrw:SetBackGround(), oBrw:SetFocus() )
SEPARATOR
MENUITEM "Paper" ACTION ( oBrw:SetBackGround( "PAPER" ), oBrw:SetFocus() )
MENUITEM "Stone" ACTION ( oBrw:SetBackGround( "STONE" ), oBrw:SetFocus() )
MENUITEM "FiveBack" ACTION ( oBrw:SetBackGround( "FIVEBACK" ), oBrw:SetFocus() )
SEPARATOR
MENUITEM "Select Image" ACTION SetBmpBack( oBrw )
MENUITEM "ImageMode"
MENU
MENUITEM "Tiled" WHEN ! Empty( oBrw:oBrush:hBitmap ) ;
ACTION ( oBrw:SetBackGround( , BCK_TILED ) )
MENUITEM "Stretch" WHEN ! Empty( oBrw:oBrush:hBitmap ) ;
ACTION ( oBrw:SetBackGround( , BCK_STRETCH ) )
MENUITEM "Fill" WHEN ! Empty( oBrw:oBrush:hBitmap ) ;
ACTION ( oBrw:SetBackGround( , BCK_FILL ) )
ENDMENU
ENDMENU
MENUITEM "Font" ACTION ( oBrw:SelFont(), oBrw:SetFocus() )
MENUITEM "Stretch"
MENU
MENUITEM "None" ACTION ( oBrw:nStretchCol := STRETCHCOL_NONE, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Last" ACTION ( oBrw:nStretchCol := STRETCHCOL_LAST, oBrw:Refresh(), oBrw:SetFocus() )
MENUITEM "Widest" ACTION ( oBrw:nStretchCol := STRETCHCOL_WIDEST, oBrw:Refresh(), oBrw:SetFocus() )
ENDMENU
MENUITEM "NoFreeze" WHEN ( oBrw:nFreeze > 0 ) ;
ACTION ( oBrw:nFreeze := 0, oBrw:Refresh(), oBrw:SetFocus() )
ENDMENU
return oPop
//----------------------------------------------------------------------------//
static function SetBmpBack( oBrw )
local cImage
if ! Empty( cImage := cGetFile( "Image File (*.bmp,jpg,png)|*.bmp;*.png;*.jpg|", ;
"Select Image file ", 1, ;
"\fwh\bitmaps" ) )
oBrw:SetBackGround( cImage )
endif
oBrw:SetFocus()
return nil
//----------------------------------------------------------------------------//
static function ViewCode( oBrw )
local aCode := Array( 4 )
local aGet := Array( 4 )
local oDlg, oFolder
local oFont
#define DLGWD 350 //250
#define DLGHT 250
aCode := oBrw:PrgCode()
DEFINE FONT oFont NAME 'LUCIDA CONSOLE' SIZE 0,-12
DEFINE DIALOG oDlg SIZE DLGWD*2, DLGHT*2 PIXEL ;
TITLE oBrw:oWnd:cTitle + " ( Source)" ;
FONT oWndDbu:oFont
@ 05,05 FOLDER oFolder ;
PROMPTS 'ListBox Style', 'CommandStyle', 'Oops Style', 'Report Code' ;
SIZE DLGWD - 10, DLGHT - 27 PIXEL ;
OF oDlg ; // ADJUST
FONT oWndDbu:oFont
@ 10,10 GET aGet[ 1 ] VAR aCode[ 1 ] TEXT ;
SIZE DLGWD-30,DLGHT-57 PIXEL ;
OF oFolder:aDialogs[ 1 ] ;
FONT oFont
@ 10,10 GET aGet[ 2 ] VAR aCode[ 2 ] TEXT ;
SIZE DLGWD-30,DLGHT-57 PIXEL ;
OF oFolder:aDialogs[ 2 ] ;
FONT oFont
@ 10,10 GET aGet[ 3 ] VAR aCode[ 3 ] TEXT ;
SIZE DLGWD-30,DLGHT-57 PIXEL ;
OF oFolder:aDialogs[ 3 ] ;
FONT oFont
@ 10,10 GET aGet[ 4 ] VAR aCode[ 4 ] TEXT ;
SIZE DLGWD-30,DLGHT-57 PIXEL ;
OF oFolder:aDialogs[ 4 ] ;
FONT oFont
@ DLGHT-20,05 BUTTONBMP BITMAP 'COPY3' SIZE 16,16 PIXEL OF oDlg ;
ACTION CopyToClip( aCode[ oFolder:nOption ] )
@ DLGHT-20,23 BUTTONBMP BITMAP 'SAVE2' SIZE 16,16 PIXEL OF oDlg ;
ACTION SaveCode( aCode[ oFolder:nOption ] )
@ DLGHT-20,41 BUTTONBMP BITMAP 'RUN' SIZE 16,16 PIXEL OF oDlg ;
ACTION CompileAndRun( aCode[ oFolder:nOption ] )
@ DLGHT-20,DLGWD-21 BUTTONBMP BITMAP 'CLOSE2' ;
SIZE 16,16 PIXEL OF oDlg ;
ACTION oDlg:End()
ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont
return nil
//----------------------------------------------------------------------------//
static function CopyToClip( cText )
local oClip
oClip := TClipBoard():New()
if oClip:Open()
oClip:SetText( cText )
oClip:Close()
endif
oClip:End()
return nil
//----------------------------------------------------------------------------//
static function SaveCode( cText )
local cFile
if ! Empty( cFile := cGetFile( "Prg File (*.PRG)|*.PRG|", ;
"Select PRG File to Save", ;
CurDir(), .t. ) )
if ! MemoWrit( cFile, cText )
MsgInfo( 'Write Failure' )
endif
endif
return nil
//----------------------------------------------------------------------------//
static function CompileAndRun( cText )
#ifdef __XHARBOUR__
MemoWrit( 'test_x.prg', cText )
WinExec( 'buildx.bat test_x' )
#else
MemoWrit( 'test_x.prg', cText )
WinExec( 'buildh.bat test_x' )
#endif
return nil
//----------------------------------------------------------------------------//
function dbfbuild()
local oDlg, oGet, oGet1, oType, oLen, oDec, oLbx, oBtnAdd, oBtnEdit
local cName := Space( 9 ) // Limit to 9 instead of 10 for TDatabase
local cType := "C"
local nLen := 10
local nDec := 0
local cField := Space( 20 )
local cTypes := "CNLDM"
local aLens := { 10, 10, 1, 8, 8 }
local cDbfName := Space( 12 )
local lEditing := .f.
cDbfName:= padr("TEST",12)
DEFINE DIALOG oDlg RESOURCE "DbfBuild" TITLE "FiveWin - DbfBuilder"
REDEFINE GET oGet VAR cName ID 110 OF oDlg picture "@!XXXXXXXXX"
REDEFINE COMBOBOX oType VAR cType ITEMS { "C", "N", "L", "D", "M" } ;
ON CHANGE ( nLen := aLens[ At( cType, cTypes ) ], oLen:Refresh() );
ID 120 OF oDlg
REDEFINE GET oLen VAR nLen PICTURE "9999" ID 130 OF oDlg
REDEFINE GET oDec VAR nDec PICTURE "9" ID 140 OF oDlg
REDEFINE BUTTON oBtnAdd ID 150 OF oDlg ;
ACTION (AddField( oLbx, oGet, oBtnAdd, oBtnEdit,;
@cName, cType, nLen, nDec, @lEditing ), oBtnAdd:oJump:= oGet, oDlg:refresh() )
REDEFINE BUTTON ID 160 OF oDlg ACTION oDlg:End()
REDEFINE LISTBOX oLbx VAR cField ID 170 OF oDlg
oLbx:blDblClick:={|| EditField( oBtnAdd, oBtnEdit,;
cField, @cName, @cType, @nLen, @nDec, @lEditing,;
oGet, oType, oLen, oDec )}
REDEFINE BUTTON oBtnEdit ID 180 OF oDlg ;
ACTION EditField( oBtnAdd, oBtnEdit,;
cField, @cName, @cType, @nLen, @nDec, @lEditing,;
oGet, oType, oLen, oDec )
REDEFINE BUTTON ID 190 OF oDlg ACTION oLbx:Del()
REDEFINE BUTTON ID 112 OF oDlg ACTION oLbx:swapUp()
REDEFINE BUTTON ID 113 OF oDlg action oLbx:swapDown()
REDEFINE BUTTON ID 111 OF oDlg ;
ACTION (cDbfName:=padr(cFileNoPath(OPEN(oLbx, cName)),12), oGet1:refresh() )
REDEFINE GET oGet1 var cDbfName ID 210 OF oDlg
REDEFINE BUTTON ID 220 OF oDlg ;
ACTION BuildDbf( trim(cDbfName), oLbx )
ACTIVATE DIALOG oDlg CENTERED ;
//on init import( cDbfName, oLbx )
return nil
//----------------------------------------------------------------------------//
static function AddField( oLbx, oGet, oBtnAdd, oBtnEdit,;
cName, cType, nLen, nDec, lEditing )
if Empty( cName )
MsgInfo( "I need a field name", "Sorry" )
else
if ! lEditing
oLbx:Add( xPadR( cName, 100 ) + cType + ;
xPadL( Str( nLen, 3 ), 50 ) + xPadL( Str( nDec, 1 ), 20 ),;
oLbx:GetPos() )
else
oLbx:Modify( xPadR( cName, 100 ) + cType + ;
xPadL( Str( nLen, 3 ), 50 ) + xPadL( Str( nDec, 1 ), 20 ) )
oBtnAdd:SetText( "&Add" )
oBtnEdit:Enable()
lEditing = .f.
endif
cName = Space( 10 )
oGet:Refresh()
oGet:SetFocus( .t. )
endif
return nil
//----------------------------------------------------------------------------//
static function BuildDbf( cDbfName, oLbx )
local aFields := {}
local n
local cTempFile:=""
if Empty( cDbfName )
MsgAlert( "I need a DBF name", "Sorry" )
return nil
endif
if Len( oLbx:aItems ) == 0
MsgAlert( "No fields defined", "Sorry" )
return nil
endif
if At( ".", cDbfName ) == 0
cDbfName += ".dbf"
endif
for n = 1 to Len( oLbx:aItems )
AAdd( aFields, _FieldInfo( AllTrim( oLbx:aItems[ n ] ) ) )
next
if File( cDbfName )
if MsgYesNo( "DBF already exists, update structure?", "Info" )
cTempFile:= tempFile("dbf")
DbCreate( cTempFile, aFields )
use (cTempFile)
append from (cDbfName)
use
ferase( cDbfName )
rename ( cTempFile ) to (cDbfName)
// Handle memo field(s)
// There is a problem when this file already exists--it doesn't get renamed for some reason.
if file( cFileNoExt( cTempFile ) +".dbt" )
//msgInfo( "memo file found")
//cOld := cFileNoExt(cTempFile)+".dbt"
//cNew := cFileNoExt( cDbfName )+".dbt"
//msgInfo( cOld, "cOld")
//msgInfo( cNew, "cNew")
rename ( cFileNoExt(cTempFile)+".dbt") to ( cFileNoExt( cDbfName )+".dbt")
//rename (cOld) to (cNew)
endif
return nil
endif
endif
DbCreate( cDbfName, aFields )
MsgInfo( "DBF created!", "AllRight" )
return nil
//----------------------------------------------------------------------------//
// Fixed function in dbfbuild.prg
static function _FieldInfo( cItem )
return { AllTrim( StrToken( cItem, 1 ) ),;
AllTrim( StrToken( cItem, 2 ) ),;
Val( StrToken( cItem, 3 ) ),;
Val( StrToken( cItem, 4 ) ) }
//----------------------------------------------------------------------------//
static function EditField( oBtnAdd, oBtnEdit, cField,;
cName, cType, nLen, nDec, lEditing,;
oName, oType, oLen, oDec )
if ! Empty( cField )
oBtnAdd:SetText( "&Replace" )
oBtnEdit:Disable()
lEditing = .t.
cName = padr(StrToken( cField, 1 ),9)
cType = StrToken( cField, 2 )
nLen = Val( StrToken( cField, 3 ) )
nDec = Val( StrToken( cField, 4 ) )
oName:Refresh()
oType:Refresh()
oLen:Refresh()
oDec:Refresh()
else
MsgInfo( "Select a field to edit", "Please" )
endif
return nil
//----------------------------------------------------------------------------//
static function import( cFile, oLbx )
local aStruct,i:=0
local cName,cType,nLen,nDec
cFile:= trim(cFile)
use (cFile)
aStruct := dbstruct()
for i:=1 to len( aStruct )
cName := aStruct[i,1]
cType := aStruct[i,2]
nLen := aStruct[i,3]
nDec := aStruct[i,4]
oLbx:Add( xPadR( cName, 100 ) + cType + ;
xPadL( Str( nLen, 3 ), 50 ) + xPadL( Str( nDec, 1 ), 20 ),;
oLbx:GetPos() )
next
use
return cName
//----------------------------------------------------------------------------//
STATIC FUNCTION OPEN(oLbx)
local cFile
local cFileMask := "Database (DBF) | *.dbf |"
local cInitialDirectory
local lSave:= .f.
local lLongNames:= .t.
cFile:= cGetFile32( cFileMask, , , cInitialDirectory, lSave, lLongNames )
if ! empty(cFile)
import( cFile, oLbx )
endif
return cFile
// Returns an unused filename with cExtension.
// cPath is optional. Defaults to current directory.
FUNCTION tempFile(cExtension,cPath)
local cFile
default cPath:=""
cExtension:= strtran(cExtension,".","")
// loop until you find a name that doesn't exist
do while .t.
cFile:="AAA"+trim(str(seconds(),5,0))+"."+upper(cExtension)
cFile:=strtran(cFile," ","0") // fix for hours between 00:00 & 01:00
cFile:= cPath + cFile
if .not. file( cFile )
exit
endif
enddo
return cPath + cFile
CLASS TDbfWnd
DATA oBrowse, oWnd
DATA cAlias
DATA lExclusive INIT .F.
METHOD New( oWndChild, oBrw )
METHOD DelRec()
METHOD EditRec()
METHOD AppRec()
METHOD Refresh() INLINE ::oBrowse:Refresh()
ENDCLASS
METHOD New( oWndChild, oBrw ) CLASS TDbfWnd
::oWnd = oWndChild
::oBrowse = oBrw
::oWnd:Cargo = Self
::oWnd:bGotFocus = { || oDbfWnd := ::oWnd:Cargo }
::cAlias = Alias()
oDbfWnd = Self
return Self
METHOD DelRec() CLASS TDbfWnd
/*
IF ! ::oItemDelReg:lActive
::oBrowse:Setfocus()
RETU NIL
ENDIF
*/
Select(::cAlias)
IF ! ::lExclusive
IF !(::cAlias)->(DbRLock())
MsgRun({|| SysWait(1) }, "Record lock error")
RETU NIL
ENDIF
ENDIF
IF Deleted()
DbRecall()
ELSE
DbDelete()
ENDIF
IF ! ::lExclusive
( ::cAlias )->( DbUnlock() )
ENDIF
IF Set( _SET_DELETED )
DO WHILE Deleted() .AND. !Bof()
DbSkip( -1 )
ENDDO
::Refresh()
ENDIF
// SayInfo(Self)
::oBrowse:Setfocus()
return nil
//----------------------------------------------------------------------------//
METHOD EditRec() CLASS TDbfWnd
MsgInfo( " EditRec ")
RETURN NIL
//----------------------------------------------------------------------------//
METHOD AppRec() CLASS TDbfWnd
// LOCAL cIndex := ::cIndex
Select(::cAlias)
APPEND BLANK
IF NetErr()
MsgRun({|| SysWait(1) },;
"Record append error")
RETU NIL
ENDIF
// ::cIndex := "<None> "
// ::ChangeOrder()
::oBrowse:GoBottom()
// ::EditFld()
RETURN NIL
//----------------------------------------------------------------------------//
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 8 guests