Amiguinhos,
Mais algumas alterações de ultima hora:
- Codigo .PRG da tabela preparado para .CDX
- Escrita do .RC obedece padrão do WorkShop
- Menu de contexto no browse do .PRG da tabela salva/trava corretamente o registro.
Codigo completo(parte 1):
#include "FiveWin.ch"
#include "Report.ch"
#include "InKey.ch"
#define DEVICE oWndPRV:cargo
#define GO_POS 0
#define GO_UP 1
#define GO_DOWN 2
#define GO_LEFT 1
#define GO_RIGHT 2
#define GO_PAGE .T.
#define VSCROLL_RANGE 20*nZFactor
#define HSCROLL_RANGE 20*nZFactor
#define TXT_FIRST "Primeira pagina" // LoadString( GetResources(), 07 )
#define TXT_PREVIOUS "Pagina anterior" // LoadString( GetResources(), 08 )
#define TXT_NEXT "Proxima pagina" // LoadString( GetResources(), 09 )
#define TXT_LAST "Ultima pagina" // LoadString( GetResources(), 10 )
#define TXT_ZOOM "Zoom" // LoadString( GetResources(), 11 )
#define TXT_UNZOOM "UnZoom" // LoadString( GetResources(), 12 )
#define TXT_TWOPAGES "Duas paginas" // LoadString( GetResources(), 13 )
#define TXT_ONEPAGE "Uma pagina" // LoadString( GetResources(), 14 )
#define TXT_PRINT "Imprime" // LoadString( GetResources(), 15 )
#define TXT_EXIT "Sair" // LoadString( GetResources(), 16 )
#define TXT_FILE "Arquivo" // LoadString( GetResources(), 17 )
#define TXT_PAGE "Pagina" // LoadString( GetResources(), 18 )
#define TXT_PREVIEW "Previsualiza" // LoadString( GetResources(), 03 )
#define TXT_PAGENUM "Numero pagina: " // LoadString( GetResources(), 19 )
#define TXT_A_WINDOW_PREVIEW_IS_ALLREADY_RUNNING "Preview ja esta ativa" // LoadString( GetResources(), 20 )
#define TXT_GOTO_FIRST_PAGE "Primeira pagina" // LoadString( GetResources(), 21 )
#define TXT_GOTO_PREVIOUS_PAGE "Pagina anterior" // LoadString( GetResources(), 22 )
#define TXT_GOTO_NEXT_PAGE "Proxima pagina" // LoadString( GetResources(), 23 )
#define TXT_GOTO_LAST_PAGE "Ultima pagina" // LoadString( GetResources(), 24 )
#define TXT_ZOOM_THE_PREVIEW "Previsualiza" // LoadString( GetResources(), 25 )
#define TXT_UNZOOM_THE_PREVIEW "Zoom" // LoadString( GetResources(), 26 )
#define TXT_PREVIEW_ON_TWO_PAGES "Duas paginas" // LoadString( GetResources(), 27 )
#define TXT_PREVIEW_ON_ONE_PAGE "Uma pagina" // LoadString( GetResources(), 28 )
#define TXT_PRINT_CURRENT_PAGE "Pagina corrente" // LoadString( GetResources(), 29 )
#define TXT_EXIT_PREVIEW "Sair" // LoadString( GetResources(), 30 )
#define TXT_FACTOR "Fator:" // LoadString( GetResources(), 31 )
#define TXT_ZOOM_FACTOR "Fator Zoom" // LoadString( GetResources(), 32 )
STATIC aFactor
STATIC nPage, nZFactor
STATIC lTwoPages, lZoom
STATIC oWndPRV, oMeta1, oMeta2,;
oPage, oTwoPages, oZoom, oMenuZoom, oMenuTwoPages,;
oMenuUnZoom, oMenuOnePage, oFactor, cResFile, oBarPGNum
#define ENGLISH
STATIC oRPTPage
STATIC cIniFile
STATIC oWnd, oClients, oClient, oName
function Main()
local cDbfFile
public wcabrel1,wcabrel2,wcabrel3,wcabrel4,wcmpgrup,wcabgrup
public wcabrodp,wMostGru,wPulaPag,wTipoPla,wPrevImp,vt1,vt2,vt3
public oPict,oCabe,oTota,oSomb,wCmpo,wPict,wCabe,wTota,wSomb
wcabrel1:=wcabrel2:=wcabrel3:=wcabrel4:=wcmpgrup:=wcabgrup:=wcabrodp:=space(150)
wMostGru:=.t.
wPulaPag:=.f.
wTipoPla:=.f.
wPrevImp:=.t.
vt1 :={} // combo header
vt2 :={} // browse readonly
vt3 :={space(150)} // campos selecionados
public aMensagens := {}
lEncripta := .t.
Request DBFCDX
RddRegister('DBFCDX',1)
RddSetDefault('DBFCDX')
Request OrdKeyNo
Request OrdKeyCount
set deleted off
Set date to british
Set exclusive off
Set century on
Set epoch to 1960
Set confirm on
Set softseek on
Set Multiple on
SetKey( VK_F2, nil )
Set Multiple off
DEFINE WINDOW oWnd TITLE "FWDBU" MDI MENU BuildMenu() COLOR "N/W"
SET MESSAGE OF oWnd TO "Testing the FiveWin Report Class" CENTERED
ACTIVATE WINDOW oWnd //ON INIT (OpenFile(),Browse(oWnd)) // VALID MsgYesNo( "Do you want to end?" )
CLOSE ALL
return nil
function BuildMenu()
local oMenu
MENU oMenu
MENUITEM "&DataBases"
MENU
MENUITEM "&Abrir arquivo..." ACTION (cDBFTitle:=OpenFile(),dbBrowse(oWnd,cDBFTitle)) ;
MESSAGE "Manutencao de arquivos"
MENUITEM "&Abrir formulario..." ACTION GenFM() ;
MESSAGE "Manutencao de formularios"
SEPARATOR
MENUITEM "&End" ACTION oWnd:End() ;
MESSAGE "End this test"
ENDMENU
oMenu:AddMdi() // Add standard MDI menu options
ENDMENU
return oMenu
function dbBrowse( oWnd, cTitle, cListName, bNew, bModify, bDelete, bSearch, bList, aColSizes )
local oDlg, oLbx, oFont
local btnNew, btnModify, btnDelete, btnSearch, btnList, btnEnd
local n, oCursor
// Reporting Tools
vt1:={}
vt2:={}
est:=DbStruct()
for i=1 to len(est)
cNom:=alias()+"->"+est[i,1]
cTip:=est[i,2]
cTam:=strzero(est[i,3],3)
cDec:=strzero(est[i,4],2)
aadd(vt1,cNom)
aadd(vt2,"[ ] "+aj(cNom,20)+" ("+cTip+", "+cTam+", "+cDec+")")
next
oWnd:SetText(OemToAnsi("FiveDBU"))
DEFINE CURSOR oCursor RESOURCE "CATCH"
//DEFAULT cTitle := "Browse", cListName := "Fields",;
DEFAULT cListName := "Fields",;
bNew := { || oLbx:RecAdd(), oLbx:Refresh() },;
bDelete := { || RecDelete( oLbx ) },;
bModify := { || RecModify( oLbx ) },;
bList := { || Report( oLbx ) }
DEFINE WINDOW oDlg TITLE cTitle MDICHILD
DEFINE BUTTONBAR oBar OF oDlg SIZE 24,24 _3D
DEFINE BUTTON OF oBar RESOURCE "btnOpen" ;
NOBORDER ACTION ( cDBFTitle:=OpenFile(), dbBrowse(oWnd,cDBFTitle), oLbx:GoBottom(), oLbx:SetFocus() ) ;
TOOLTIP "Abrir outra tabela"
DEFINE BUTTON OF oBar RESOURCE "btnNew" ;
GROUP NOBORDER ACTION ( Eval( bNew, oDlg ), oLbx:GoBottom(), oLbx:SetFocus() ) ;
TOOLTIP "Adicionar registro"
DEFINE BUTTON OF oBar RESOURCE "btnEdit" ;
NOBORDER ACTION If( bModify != nil, ( Eval( bModify, oDlg ), oLbx:Refresh(), oLbx:SetFocus() ),) ;
ON DROP If( bModify != nil, ( Eval( bModify, oDlg ), oLbx:Refresh(), oLbx:SetFocus() ),);
TOOLTIP "Editar registro corrente"
DEFINE BUTTON OF oBar RESOURCE "btnDelete" ;
NOBORDER ACTION If( bDelete != nil, ( Eval( bDelete, oDlg ), oLbx:Refresh(), oLbx:SetFocus() ),) ;
ON DROP If( bDelete != nil, ( Eval( bDelete, oDlg ), oLbx:Refresh(), oLbx:SetFocus() ),) ;
TOOLTIP "Deletar registro corrente"
DEFINE BUTTON OF oBar RESOURCE "btnSearch" ;
NOBORDER ACTION If( bSearch != nil, ( Eval( bSearch, oDlg ), oLbx:Refresh(), oLbx:SetFocus() ),) ;
TOOLTIP "Localizar registro"
DEFINE BUTTON OF oBar RESOURCE "btnPrint" ;
NOBORDER ACTION ( Eval( bList, oDlg ), oLbx:Refresh(), oLbx:SetFocus() ) ;
TOOLTIP "Imprimir"
DEFINE BUTTON OF oBar RESOURCE "btnDesign" ;
GROUP NOBORDER ACTION CriaDbf() TOOLTIP "Ver estrutura"
DEFINE BUTTON OF oBar RESOURCE "btnDialog" ;
NOBORDER ACTION GenRC() TOOLTIP "Cria Dialog Resource"
DEFINE BUTTON OF oBar RESOURCE "btnCode" ;
NOBORDER ACTION GeraCode() TOOLTIP "Gera codigo do dialogo"
DEFINE BUTTON OF oBar RESOURCE "btnWizard" ; // GETHEADER()
GROUP NOBORDER ACTION rptWizard( "Preparacao do layout do relatorio",;
"Nesta opcao voce sera auxiliado a preparar todo o layout de seu relatori pessoal",;
"btnWizard", ;
{ "dlgWizard1", "dlgWizard2", "dlgWizard3", "dlgWizard4" },;
{ {||fncWizard1(oRPTPage,1)}, {||fncWizard2(oRPTPage,2)}, {||fncWizard3(oRPTPage,3)}, {||fncWizard4(oRPTPage,4)} } ) TOOLTIP "Monta layout do relatorio"
DEFINE BUTTON OF oBar RESOURCE "btnAZAsc" ;
NOBORDER ACTION fun() TOOLTIP "Monta layout do relatorio"
DEFINE BUTTON OF oBar RESOURCE "btnAZDesc" ;
NOBORDER ACTION fun() TOOLTIP "Gera codigo do relatorio"
//DEFINE BUTTON OF oBar RESOURCE "btnReport" ;
// NOBORDER ACTION GETCAMPOS() TOOLTIP "Monta layout do relatorio"
//DEFINE BUTTON OF oBar RESOURCE "btnCode" ;
// NOBORDER ACTION GeraPrg() TOOLTIP "Gera codigo do relatorio"
//DEFINE BUTTON OF oBar RESOURCE "btnPreview" ;
// NOBORDER ACTION TestaRel() TOOLTIP "Previsualiza relatorio na tela"
DEFINE BUTTON OF oBar RESOURCE "btnImport" ;
GROUP NOBORDER ACTION fun() TOOLTIP "Importar dados"
DEFINE BUTTON OF oBar RESOURCE "btnExit" ;
GROUP NOBORDER ACTION oWnd:End() TOOLTIP "Sair"
oBar:bRClicked := {|| NIL }
@ 2, 1 LISTBOX oLbx FIELDS SIZE 284, 137 OF oDlg
oLbx:bLDblClick := { | nRow, nCol | EditCell( oLbx, nRow, nCol ) }
oLbx:bKeyDown := { | nKey, nFlags | KeyDown( oLbx, nKey, nFlags ) }
oLbx:bKeyChar := { | nKey, nFlags | KeyChar( oLbx, nKey, nFlags ) }
oLbx:aActions := Array( ( Alias() )->( FCount() ) )
if aColSizes != nil
oLbx:aColSizes = aColSizes
endif
for n = 1 to Len( oLbx:aActions )
oLbx:aActions[ n ] = { || MsgInfo( "Column action" ) }
next
//oLbx:nLineStyle := 3
//oLbx:bTextColor := {|nRow,nCol| if(nCol=iif(OrdNumber()=1,2,3).and.nRow>0,CLR_BLACK,)}
//oLbx:bbkColor := {|nRow,nCol| if(nCol=iif(OrdNumber()=1,2,3).and.nRow>0,nRGB(244,244,255),)}
oLbx:lMChange := .t. // Desabilta Mousemove
//oLbx:oVScroll:SetRange(0,recco())
//oLbx:bchange := {||oLbx:ovscroll:setpos((oLbx:cAlias)->(ordkeyno()))} //ok
//oLbx:blogiclen := {||oLbx:nlen:=(oLbx:cAlias)->(ordkeycount())} // ok
//-> Estilo FLAT
oLbx:nHeaderStyle := 2
oLbx:nHeaderHeight := 20
oLbx:nClrPane := { || IIF( deleted(),nRGB(255,148,148), IIF( ( oLbx:cAlias)->(OrdKeyNo()) %2 == 1,nRGB(255,255,255),nRGB(244,244,244))) }
//oLbx:aColSizes := aColSizes
//oLbx:bLine := abLine
//oLbx:aHeaders := aHeaders
//oLbx:oVScroll:SetRange(0,recno())
//oLbx:oHScroll:bPos := {|nPos| oLbx:oVscroll:SetPos(recno())}
oDlg:SetControl( oLbx )
oDlg:nStyle := 1
oLbx:oDragCursor := oCursor
oLbx:bDropOver := { || MsgStop( "I'm not a Button, try again" ) }
ACTIVATE WINDOW oDlg VALID( oDlg := nil, .t. ) MAXIMIZED
return nil
function Report( oLbx )
local oRpt
local n
local cAlias := If( oLbx != nil, oLbx:cAlias, Alias() )
REPORT oRpt TITLE "Report: " + cAlias ;
HEADER "Date: " + DToC( Date() ) + ", Time: " + Time() ;
FOOTER "Page: " + Str( oRpt:nPage, 3 ) ;
PREVIEW
if Empty( oRpt ) .or. oRpt:oDevice:hDC == 0
return nil
endif
for n = 1 to FCount()
oRpt:AddColumn( TrColumn():New( { FInfo1( cAlias, n ) },,;
{ FInfo2( cAlias, n ) },,,,,,,,,, oRpt ) )
next
ENDREPORT
ACTIVATE REPORT oRpt
GO TOP
return nil
static function FInfo1( cAlias, n )
return { || ( cAlias )->( FieldName( n ) ) }
static function FInfo2( cAlias, n )
return { || ( cAlias )->( FieldGet( n ) ) }
static function RecModify( oLbx )
local n := 1
local nCols := ( oLbx:cAlias )->( FCount() )
local u := ( oLbx:cAlias )->( FieldGet( 1 ) )
do while n <= nCols .and. oLbx:lEditCol( n, @u )
oLbx:DrawSelect()
SysRefresh()
if ( oLbx:cAlias )->( RLock() )
( oLbx:cAlias )->( FieldPut( n, u ) )
UNLOCK
else
MsgAlert( "DataBase non available" )
n = nCols + 1
endif
n++
if n <= nCols
u = ( oLbx:cAlias )->( FieldGet( n ) )
endif
enddo
return nil
static function EditCell( oLbx, nRow, nCol )
local nColumn := oLbx:nAtCol( nCol )
local u := ( oLbx:cAlias )->( FieldGet( nColumn ) )
if ValType( ( oLbx:cAlias )->( FieldGet( nColumn ) ) ) == "M"
if MemoEdit( @u )
if ( oLbx:cAlias )->( RLock() )
( oLbx:cAlias )->( FieldPut( nColumn, u ) )
UNLOCK
oLbx:DrawSelect()
else
MsgAlert( "DataBase non available" )
endif
endif
else
if oLbx:lEditCol( nColumn, @u )
if ( oLbx:cAlias )->( RLock() )
( oLbx:cAlias )->( FieldPut( nColumn, u ) )
UNLOCK
oLbx:DrawSelect()
else
MsgAlert( "DataBase non available" )
endif
endif
endif
return nil
static function KeyDown( oLbx, nKey, nFlags )
do case
case nKey == VK_DELETE
RecDelete( oLbx )
endcase
return nil
static function KeyChar( oLbx, nKey, nFlags )
do case
case nKey == K_ENTER
RecModify( oLbx )
endcase
return nil
static function RecDelete( oLbx )
if Deleted()
if MsgYesNo( "Recupera este registro?", "Confirme" )
RECALL
endif
else
if MsgYesNo( "Deleta este registro?", "Confirme" )
DELETE
endif
endif
oLbx:Refresh()
return nil
static function OpenFile()
cDbfFile := cGetFile( "dBase III (*.dbf)| *.dbf|" + ;
"Etiqueta (*.eti)| *.eti|" + ;
"All Files (*.*)| *.*", "Selecione um arquivo", 1 )
USE (cDbfFile) NEW SHARED
return cDbfFile
static function fun()
return nil
/*
* ******* ******* ******* *******
* Modulo de criacao de resources
* ******* ******* ******* *******
*/
FUNCTION GenRC()
LOCAL n, nId := 110
LOCAL cRC := ""
LOCAL cCH := "// Generated by DBF2RC" + CRLF
LOCAL aFields
LOCAL cRCFile := ""
cDbfName := dbf()+".DBF"
CursorWait()
dbSelectArea( alias() )
aFields := dbstruct()
//cRC += '#include "WinApi.ch"' + CRLF
cRC += '#include "' + alias() + '.ch"' + CRLF + CRLF
cRC += alias() + " DIALOG 32, 18, 236," + ;
str( ( len( aFields ) * 14) + 30, 4 ) + CRLF
cRC += "STYLE DS_MODALFRAME | WS_POPUP | WS_CAPTION |"+ ;
" WS_SYSMENU" + CRLF
cRC += 'CAPTION "' + alias() + '"' + CRLF
cRC += 'FONT 8, "MS Sans Serif"' + CRLF
cRC += "{" + CRLF
FOR n := 1 TO len( aFields )
cCH += "#define ID_" + PadR( aFields[ n ][ 1 ], 11 ) + ;
str( nId, 4 ) + CRLF
DO CASE
CASE aFields[ n ][ 2 ] $ "CND"
cRC += ' RTEXT "' + properCase(aFields[n][1]) + '"' + ;
space(10-len( aFields[ n ][ 1 ] ) ) + ", -1, 3,"+;
str( 5 + 14 * ( n - 1 ), 4 ) + ", 41, 8" + CRLF
cRC += " EDITTEXT ID_" + aFields[ n ][ 1 ] + ;
", 45," + str( 3 + 14 * ( n - 1 ), 4 ) + ", " + ;
str( aFields[ n ][ 3 ] * 7 *.5 + 8, 4 ) + ", 12" + CRLF
CASE aFields[ n ][ 2 ] == "L"
cRC += ' CONTROL "' + properCase(aFields[ n ][ 1 ]) + ;
'", ID_' + aFields[ n ][ 1 ] + ;
', "BUTTON", BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, ' + ;
"45, " + str( 3 + 14 * ( n - 1 ), 4 ) + ;
", 50, 12" + CRLF
CASE aFields[ n ][ 2 ] == "M"
cRC += ' RTEXT "' + properCase(aFields[ n ][ 1 ]) + '"' + ;
space( 10 - len( aFields[ n ][ 1 ] ) ) + ", -1, 100," + ;
str( 5 + 14 * ( n - 1 ), 4 ) + ", 41, 8" + CRLF
// cRC += ' CONTROL "' + aFields[ n ][ 1 ] + ;
cRC += ' CONTROL "' + "" + ;
'", ID_' + aFields[ n ][ 1 ] + ;
', "EDIT", ES_LEFT | ES_MULTILINE | ES_WANTRETURN | WS_CHILD | WS_VISIBLE | WS_BORDER | WS_VSCROLL | WS_TABSTOP , ' + ;
"145, " + str( 3 + 14 * ( n - 1 ), 4 ) + ", " + "77, 63" + CRLF
//^^^ gotta put it out to the right somewhere so you can see it
// and not sit under a bunch of other controls
ENDCASE
nId += 10
NEXT
cRC += ' PUSHBUTTON "OK", 5001, 110, ' + str( ( len( aFields ) * 14) + 10, 4 ) + ', 50, 14'
cRC += ' PUSHBUTTON "Cancela", 5002, 161, ' + str( ( len( aFields ) * 14) + 10, 4 ) + ', 50, 14'
cRC += "}" + CRLF
/* Add version info to .RC // CLW
cRC += "" + CRLF
cRC +='1 VERSIONINFO LOADONCALL MOVEABLE '+ CRLF
cRC +='FILEVERSION 1, 0, 0, 0' + CRLF
cRC +='PRODUCTVERSION 1, 0, 0, 0' + CRLF
cRC +='FILEOS VOS__WINDOWS16' + CRLF
cRC +=' {' + CRLF
cRC +=' BLOCK "StringFileInfo"' + CRLF
cRC +=' {' + CRLF
cRC +=' BLOCK "040904E4"' + CRLF
cRC +=' {' + CRLF
cRC +=' VALUE "ProductVersion", "Created by DBF2RC"'+ CRLF
cRC +=' VALUE "FileVersion", " Created on '+ ;
dtoc(date())+' at '+time()+'"' + CRLF
cRC +=' VALUE "FileDescription", "Generated by DBF2RC"'+CRLF
cRC +=' }' + CRLF
cRC +='' + CRLF
cRC +=' }' + CRLF
cRC +='' + CRLF
cRC +='}' + CRLF
*/
memowrit( alias() + ".ch", cCH )
cRCFile := alias() + ".rc"
CursorArrow()
IF !file(alias() + ".rc")
CursorWait()
memowrit( alias() + ".rc", cRC )
ELSEIF MsgYesno( ;
"That Resource Already Exists - Overwrite it?", "OOPS")
CursorWait()
memowrit( alias() + ".rc", cRC )
ELSE
MsgStop("Rename the existing " +cRCFile + " and try again")
ENDIF
CursorArrow()
WinExec( "workshop" + " " + cRCFile )
RETURN( NIL )
static function properCase(cString)
return left(cString,1)+ lower(right(cString,len(cString)-1))
/*
* ******* ******* ******* *******
* Modulo de criacao de estruturas
* ******* ******* ******* *******
*/
static Function CriaDbf()
local oDlg, oGet, oType, oLen, oDec, oBtnAdd, oBtnEdit, oDBFLbx
local cName := space( 10 )
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 := iif( empty(alias()),space(12),alias()+".dbf")
local lEditing := .f.
local i,estr,wNom,wTip,wTam,wDec,okprc:=.f.
SET _3DLOOK ON
DEFINE DIALOG oDlg RESOURCE "tela3"
REDEFINE GET oGet VAR cName ID 110 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 GET cDbfName ID 210 OF oDlg
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 BUTTON oBtnAdd ID 150 OF oDlg ACTION AddField(oDBFLbx,oGet,oBtnAdd,oBtnEdit,@cName, cType, nLen, nDec, @lEditing )
REDEFINE BUTTON oBtnEdit ID 180 OF oDlg ACTION EditField( oBtnAdd, oBtnEdit,cField, @cName, @cType, @nLen, @nDec, @lEditing,oGet, oType, oLen, oDec )
REDEFINE BUTTON ID 160 OF oDlg ACTION oDlg:End()
REDEFINE BUTTON ID 190 OF oDlg ACTION oDBFLbx:Del()
REDEFINE BUTTON ID 220 OF oDlg ACTION BuildDbf( cDbfName, oDBFLbx )
REDEFINE BUTTON ID 230 OF oDlg ACTION LeAlias(oDBFLbx)
REDEFINE LISTBOX oDBFLbx VAR cField ID 170 OF oDlg
ACTIVATE DIALOG oDlg CENTERED ON INIT LeAlias(oDBFLbx)
SET _3DLOOK OFF
return nil
Function AddField(oLbx,oGet,oBtnAdd,oBtnEdit,cName,cType,nLen,nDec,lEditing )
if Empty( cName )
MsgInfo( "Falta o nome do campo...", "Atencao" )
else
if !lEditing
oLbx:Add( xPadR( cName, 100 ) + Chr( 9 ) + cType + xPadL( Str( nLen, 3 ), 50 ) + xPadL( Str( nDec, 1 ), 20 ),oLbx:GetPos() )
else
oLbx:Modify( xPadR( cName, 100 ) + Chr( 9 ) + 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
Function BuildDbf( cDbfName, oLbx )
local aFields := {}
local n
if Empty( cDbfName )
MsgAlert( "Falta informar o nome da tabela!", "Atencao" )
return nil
endif
if Len( oLbx:aItems ) == 0
MsgAlert( "Falta definir campos!", "Atencao" )
return nil
endif
if At( ".", cDbfName ) == 0
cDbfName += ".dbf"
endif
if File( cDbfName )
if ! MsgYesNo( "Criar assim mesmo", "Esta tabela ja existe!" )
return nil
endif
endif
for n = 1 to Len( oLbx:aItems )
AAdd( aFields, _FieldInfo( AllTrim( oLbx:aItems[ n ] ) ) )
next
DbCreate( cDbfName, aFields )
if file( cDbfName )
MsgInfo( "Tabela criada!", "Atencao!" )
else
MsgInfo( "Tabela nao criada!", "Atencao!" )
endif
return nil
STATIC FUNCTION LeAlias(oLbx)
if !empty(alias())
estr:=DbStruct()
for i=1 to len(estr)
wNom:=estr[i,1]
wTip:=estr[i,2]
wTam:=estr[i,3]
wDec:=estr[i,4]
oLbx:Add(xPadR(wNom,100)+Chr(9)+wTip+xPadL(Str(wTam,3),50)+;
xPadL(Str(wDec,1),20),oLbx:GetPos())
next
EndIf
return(.t.)
STATIC FUNCTION _FIELDINFO( CITEM )
return {StrToken(cItem,1),StrToken(cItem,2),Val(StrToken(cItem,3)),Val(StrToken(cItem,4))}
FUNCTION EDITFIELD(OBTNADD,OBTNEDIT,CFIELD,CNAME,CTYPE,NLEN,NDEC,LEDITING,ONAME,OTYPE,OLEN,ODEC)
if !Empty( cField )
oBtnAdd:SetText( "&Grava" )
oBtnEdit:Disable()
lEditing = .t.
cName = StrToken( cField, 1 )
cType = StrToken( cField, 2 )
nLen = Val( StrToken( cField, 3 ) )
nDec = Val( StrToken( cField, 4 ) )
oName:Refresh()
oType:Refresh()
oLen:Refresh()
oDec:Refresh()
else
MsgInfo( "Selecione um campo para editar", "Por favor..." )
endif
return nil
FUNCTION AJ(txt,nt)
txt:=substr(txt+space(nt),1,nt)
return(txt)
/*
* ******* ******* ******* *******
* Modulo de criacao de relatorios
* ******* ******* ******* *******
*/
FUNCTION rptWizard( cTitulo, cDescricao, cBitmap, aDialogs, bRotinas )
local oRPTDlg, oRPTFont[2] // , oRPTPage
SET _3DLOOK ON
DEFINE FONT oRPTFont[1] NAME "Helv" SIZE 6, 6 BOLD
DEFINE FONT oRPTFont[2] NAME "Helv" SIZE 6, 6
DEFINE DIALOG oRPTDlg RESOURCE "dlgWizard" FONT oRPTFont[2]
REDEFINE SAY oRPTSay0 VAR "" ID 099 OF oRPTDlg COLOR RGB(000,000,000),nRGB(255,255,255) FONT oRPTFont[1]
REDEFINE SAY oRPTSay1 VAR cTitulo ID 101 OF oRPTDlg COLOR RGB(000,000,000),nRGB(255,255,255) FONT oRPTFont[1]
REDEFINE SAY oRPTSay2 VAR cDescricao ID 102 OF oRPTDlg COLOR RGB(000,000,000),nRGB(255,255,255) FONT oRPTFont[2]
REDEFINE BITMAP oRPTBmp ID 103 OF oRPTDlg RESOURCE cBitmap TRANSPARENT
oRPTPage := TPages():Redefine( 100, oRPTDlg, aDialogs )
AEval( bRotinas, {|uElem,n| eval( bRotinas[n] ) } )
REDEFINE BUTTON oRPTBtn1 ID 4 OF oRPTDlg ACTION oRPTPage:GoPrev()
REDEFINE BUTTON oRPTBtn2 ID 5 OF oRPTDlg ACTION oRPTPage:GoNext()
REDEFINE BUTTON oRPTBtn3 ID 6 OF oRPTDlg ACTION oRPTDlg:End()
ACTIVATE DIALOG oRPTDlg CENTERED
RETURN(.T.)
FUNCTION fncWizard1( oPage, nNumber )
REDEFINE GET oCabRep1 VAR wcabrel1 ID 115 OF oPage:aDialogs[nNumber] UPDATE
REDEFINE GET oCabRep2 VAR wcabrel2 ID 116 OF oPage:aDialogs[nNumber] UPDATE
REDEFINE GET oCabRep3 VAR wcabrel3 ID 117 OF oPage:aDialogs[nNumber] UPDATE
REDEFINE GET oCabRep4 VAR wcabrel4 ID 118 OF oPage:aDialogs[nNumber] UPDATE
REDEFINE COMBOBOX oCmpGrup VAR wcmpgrup ITEMS vt1 ID 105 OF oPage:aDialogs[nNumber] UPDATE
REDEFINE GET oCmpCabg VAR wcabgrup ID 106 OF oPage:aDialogs[nNumber] UPDATE
REDEFINE GET oCmpRoda VAR wcabrodp ID 107 OF oPage:aDialogs[nNumber] UPDATE
REDEFINE CHECKBOX oMostGru VAR wMostGru ID 108 OF oPage:aDialogs[nNumber] UPDATE
REDEFINE CHECKBOX oPulaPag VAR wPulaPag ID 109 OF oPage:aDialogs[nNumber] UPDATE
REDEFINE CHECKBOX oTipoPla VAR wTipoPla ID 121 OF oPage:aDialogs[nNumber] UPDATE
REDEFINE CHECKBOX oPrevImp VAR wPrevImp ID 122 OF oPage:aDialogs[nNumber] UPDATE
RETURN(.T.)
FUNCTION fncWizard2( oPage, nNumber )
public oBrw1, oBrw2
REDEFINE BUTTON oRPTBtn1 ID 101 OF oPage:aDialogs[nNumber] ACTION (AtuCmp(oBrw1:nAt,1),oBrw1:DrawSelect())
REDEFINE BUTTON oRPTBtn2 ID 102 OF oPage:aDialogs[nNumber] ACTION (AtuCmp(oBrw1:nAt,1),oBrw1:DrawSelect())
REDEFINE LISTBOX oBrw1 ;
FIELDS vt2[ oBrw1:nAt ] ID 103 OF oPage:aDialogs[nNumber] SIZES 200 HEADERS "" ;
ON DBLCLICK (AtuCmp(oBrw1:nAt,1),oBrw1:DrawSelect())
oBrw1:SetArray( vt2 )
oBrw1:lMChange:= .f. // set false to prevent Mouse colm resize/drag
REDEFINE LISTBOX oBrw2 ;
FIELDS vt3[ oBrw2:nAt ] ID 105 OF oPage:aDialogs[nNumber] SIZES 200 HEADERS "" ;
ON DBLCLICK (AtuCmp(oBrw2:nAt,2),oBrw2:DrawSelect())
oBrw2:SetArray( vt3 )
oBrw2:lMChange:= .f. // set false to prevent Mouse colm resize/drag
RETURN(.T.)
FUNCTION fncWizard3( oPage, nNumber )
REDEFINE BUTTON oRPTBtn1 ID 103 OF oPage:aDialogs[nNumber] ACTION ( GeraPRG(), oPage:GoNext() )
RETURN(.T.)
FUNCTION fncWizard4( oPage, nNumber )
REDEFINE BUTTON oRPTBtn1 ID 103 OF oPage:aDialogs[nNumber] ACTION TestaREL()
RETURN(.T.)
FUNCTION GETHEADER()
local odlg
if empty(alias())
MsgAlert("Base de dados nao selecionada!","Bebeu?")
return(.t.)
endif
DEFINE DIALOG oDlg RESOURCE "TELA1" TITLE " Definicao do header "
Redefine GET oCabRep1 var wcabrel1 id 115 of odlg UPDATE
Redefine GET oCabRep2 var wcabrel2 id 116 of odlg UPDATE
Redefine GET oCabRep3 var wcabrel3 id 117 of odlg UPDATE
Redefine GET oCabRep4 var wcabrel4 id 118 of odlg UPDATE
Redefine ComboBox oCmpGrup var wcmpgrup ITEMS vt1 id 105 of odlg UPDATE
Redefine GET oCmpCabg var wcabgrup id 106 of odlg UPDATE
Redefine GET oCmpRoda var wcabrodp id 107 of odlg UPDATE
Redefine CheckBox oMostGru var wMostGru id 108 of odlg UPDATE
Redefine CheckBox oPulaPag var wPulaPag id 109 of odlg UPDATE
Redefine CheckBox oTipoPla var wTipoPla id 121 of odlg UPDATE
Redefine CheckBox oPrevImp var wPrevImp id 122 of odlg UPDATE
Redefine Button BotOk id 110 of oDlg action oDlg:end()
ACTIVATE DIALOG oDlg CENTERED
RETURN(.T.)
FUNCTION GETCAMPOS()
local odlg
DEFINE DIALOG oDlg RESOURCE "TELA2" TITLE "Definicao de colunas"
REDEFINE LISTBOX oBrw1 ;
FIELDS vt2[ oBrw1:nAt ] ID 103 OF oDlg SIZES 200 HEADERS "" ;
ON DBLCLICK (AtuCmp(oBrw1:nAt,1),oBrw1:DrawSelect())
oBrw1:SetArray( vt2 )
oBrw1:lMChange:= .f. // set false to prevent Mouse colm resize/drag
REDEFINE LISTBOX oBrw2 ;
FIELDS vt3[ oBrw2:nAt ] ID 105 OF oDlg SIZES 200 HEADERS "" ;
ON DBLCLICK (AtuCmp(oBrw2:nAt,2),oBrw2:DrawSelect())
oBrw2:SetArray( vt3 )
oBrw2:lMChange:= .f. // set false to prevent Mouse colm resize/drag
ACTIVATE DIALOG oDlg CENTERED
RETURN NIL
FUNCTION AtuCmp(nRow,nInd)
local ctxt
if nInd==1 // dblclick brw1, tirar
ctxt:=Vt2[nRow]
if substr(ctxt,3,1)="x" // retirar to Vt3
wCmp:=substr(ctxt,7,20)
cTxt:="[ ] "+substr(ctxt,7)
Vt2[nRow]:=ctxt
Vtx:=Vt3
Vt3:={}
for i=1 to len(Vtx)
if substr(Vtx[i],2,len(wCmp))#wCmp
aadd(Vt3,Vtx[i])
endif
next
if empty(vt3)
aadd(vt3,space(80))
endif
else // adicionar no vt3
wCmpo:=substr(ctxt,7,20)
wPict:=space(20)
wNpos:=at("->",wCmpo)+2
wCabe:=aj(iif(wnpos=2,wCmpo,substr(wCmpo,wnpos)),30)
wTota:=.f.
wSomb:=.f.
wtext:=EditVt()
if !empty(wText)
cTxt:="[ x ] "+substr(Vt2[nRow],7)
Vt2[nRow]:=ctxt
if empty(vt3[1])
vt3[1]:=wText
else
aadd(Vt3,wText)
endif
endif
endif
oBrw2:SetArray( vt3 )
oBrw1:refresh()
oBrw2:refresh()
elseif nInd==2 // brw2 alterar
ctext:=Vt3[nRow]
if empty(ctext)
return(.f.)
endif
wCmpo:=substr(ctext,02,20)
wPict:=substr(ctext,26,20)
wCabe:=substr(ctext,50,30)
wTota:=(substr(ctext,84,01)=="S")
wSomb:=(substr(ctext,89,01)=="S")
wtext:=EditVt()
if !empty(wText)
Vt3[nRow]:=wtext
endif
oBrw2:refresh()
endif
return(.t.)
FUNCTION EDITVt()
local odlg,lok:=.f.
DEFINE DIALOG oDlg RESOURCE "TELA4" TITLE "Definicao de colunas"
Redefine GET oCmpo var wCmpo id 105 of oDlg
Redefine GET oPict var wPict id 102 of oDlg
Redefine GET oCabe var wCabe id 104 of oDlg
Redefine CHECKBOX oTota var wTota id 109 of oDlg
Redefine CHECKBOX oSomb var wSomb id 110 of oDlg
Redefine BUTTON Confir id 106 of oDlg action (lok:=.t.,oDlg:end())
Redefine BUTTON Cancel id 107 of oDlg action (lok:=.f.,oDlg:end())
ACTIVATE DIALOG oDlg CENTERED
wTota:=iif(wTota,"S","N")
wSomb:=iif(wSomb,"S","N")
ctext:=iif(!lok,"","["+wCmpo+"] ["+wPict+"] ["+wCabe+"] ["+wTota+"] ["+wSomb+"]")
return(ctext)
FUNCTION TestaRel()
local i
if empty(alias())
MsgAlert("Base de dados nao selecionada!","Bebeu?")
return(.t.)
endif
goto top
Define Font oFnt Name 'ARIAL' Size -0,09
Report oReport Title wcabrel1,wcabrel2,wcabrel3,wcabrel4 ;
Header 'Data: '+dtoc(date()),'Hora: '+time() RIGHT ;
Footer OemtoAnsi('PÂ gina: ')+str(oReport:nPage,3) Center Font ofnt Preview
if !empty(wCmpGrup)
if !wPulaPag
Group ON &wCmpGrup Header wcabgrup+" "+iif(!wMostGru,"",&wCmpGrup)
else
Group ON &wCmpGrup Header wcabgrup+" "+iif(!wMostGru,"",&wCmpGrup) Eject
endif
endif
for i=1 to len(Vt3)
cText:=vt3[i]
wCmpo:=alltrim(substr(ctext,02,20))
wPict:=alltrim(substr(ctext,26,20))
wCabe:='"'+alltrim(substr(ctext,50,30))+'"'
wTota:=(substr(ctext,84,01)=="S")
wSomb:=(substr(ctext,89,01)=="S")
if wTota
if empty(wPict)
Column Title &wCabe Data &wCmpo total
else
Column Title &wCabe Data &wCmpo picture wPict total
endif
else
if empty(wPict)
Column Title &wCabe Data &wCmpo
else
Column Title &wCabe Data &wCmpo picture wPict
endif
endif
next
End report
if wTipoPla:=.f.
oReport:CellView()
endif
Activate Report oreport
return(.t.)
FUNCTION GeraPrg()
local i,crlf:=chr(13)+chr(10)
if empty(alias())
MsgAlert("Base de dados nao selecionada!","Bebeu?")
return(.t.)
endif
if file( alias()+"R.PRG" )
if ! MsgYesNo("Arquivo "+alias()+"R.PRG"+" ja existe, re-escrever?","Bebeu?")
return(.t.)
endif
endif
oText := TTxtFile():New( alias()+"R.PRG" )
if oText:Open()
oText:Add( "" )
oText:Add( '#include "fivewin.ch"' )
oText:Add( '#include "report.ch" ' )
oText:Add( '' )
oText:Add( 'Function Main()' )
oText:Add( ' USE '+alias()+' NEW SHARED' )
oText:Add( ' GO TOP' )
oText:Add( '' )
oText:Add( ' DEFINE FONT oFnt NAME "ARIAL" Size -0,09' )
oText:Add( '' )
oText:Add( ' REPORT oReport TITLE ;' )
oText:Add( ' "'+alltrim(wcabrel1)+'","'+alltrim(wcabrel2)+'","'+alltrim(wcabrel3)+'",;' )
oText:Add( ' "'+alltrim(wcabrel4)+'","";' )
oText:Add( ' HEADER "Data: "+dtoc(date()),"Hora: "+time() RIGHT ;' )
oText:Add( ' FOOTER OemtoAnsi("PÂ gina: ")+str(oReport:nPage,3) CENTER FONT ofnt PREVIEW' )
oText:Add( '' )
if !empty(wCmpGrup)
if !wPulaPag
oText:Add( ' GROUP ON '+wCmpGrup+' HEADER "'+alltrim(wcabgrup)+': "+ '+iif(!wMostGru,'',wCmpGrup) )
oText:Add( '' )
else
oText:Add( ' GROUP ON '+wCmpGrup+' HEADER "'+alltrim(wcabgrup)+': "+ '+iif(!wMostGru,'',wCmpGrup)+' EJECT' )
oText:Add( '' )
endif
endif
for i=1 to len(Vt3)
cText:=vt3[i]
wCmpo:=alltrim(substr(ctext,02,20))
wPict:=alltrim(substr(ctext,26,20))
wCabe:=[']+alltrim(substr(ctext,50,30))+[']
wTota:=(substr(ctext,84,01)=='S')
wSomb:=(substr(ctext,89,01)=='S')
if wTota
if empty(wPict)
oText:Add( ' COLUMN TITLE '+wCabe+' DATA '+wCmpo+' TOTAL' )
else
oText:Add( ' COLUMN TITLE '+wCabe+' DATA '+wCmpo+' PICTURE "'+wPict+'" total' )
endif
else
if empty(wPict)
oText:Add( ' COLUMN TITLE '+wCabe+' DATA '+wCmpo )
else
oText:Add( ' COLUMN TITLE '+wCabe+' DATA '+wCmpo+' PICTURE "'+wPict+'"' )
endif
endif
next
oText:Add( '' )
oText:Add( ' END REPORT' )
if wTipoPla:=.f.
oText:Add( ' oReport:CellView()' )
endif
oText:Add( ' ACTIVATE REPORT oReport' )
oText:Add( 'return(.t.)' )
oText:Close()
endif
return(.t.)
/*
* ******* ******* ******* ******* *
* Modulo de criacao de codigo fonte
* ******* ******* ******* ******* *
*/
function GeraCode()
local cfile := alias(), ordarea := select()
prg_name := alltrim(cfile)
cFile := alltrim(prg_name) + '.prg'
//use (prg_name)
if file(cFile)
if ! MsgYesNo("Arquivo "+cFile+" existe, re-criar?")
return nil
endif
endif
copy structure extend to temp
use temp new shared
go top
ret_line := "chr(13)+chr(10)"
errhandle = fcreate(cFile)
fwrite(errhandle,[#include "FiveWin.ch"]+&ret_line.)
fwrite(errhandle,[#include "]+upper(prg_name)+[.ch"]+&ret_line.)
fwrite(errhandle,[]+&ret_line.)
fwrite(errhandle,[function Main( cLibName )]+&ret_line.)
fwrite(errhandle,[ //]+&ret_line.)
fwrite(errhandle,[ // -> Defina todos os OBJs iniciais ou conforme for necessario como LOCAL]+&ret_line.)
fwrite(errhandle,[ LOCAL oWnd]+&ret_line.)
fwrite(errhandle,[]+&ret_line.)
fwrite(errhandle,[ Request DBFCDX]+&ret_line.)
fwrite(errhandle,[ RddRegister('DBFCDX',1)]+&ret_line.)
fwrite(errhandle,[ RddSetDefault('DBFCDX')]+&ret_line.)
fwrite(errhandle,[ Request OrdKeyNo]+&ret_line.)
fwrite(errhandle,[ Request OrdKeyCount]+&ret_line.)
fwrite(errhandle,[]+&ret_line.)
fwrite(errhandle,[ set deleted off]+&ret_line.)
fwrite(errhandle,[ Set date to british]+&ret_line.)
fwrite(errhandle,[ Set exclusive off]+&ret_line.)
fwrite(errhandle,[ Set century on]+&ret_line.)
fwrite(errhandle,[ Set epoch to 1960]+&ret_line.)
fwrite(errhandle,[ //]+&ret_line.)
fwrite(errhandle,[ // -> Variaveis de suporte ao database]+&ret_line.)
fwrite(errhandle,' PUBLIC oFont[10],;'+&ret_line.)
go top
quantas := recco()
for i = 1 to quantas
if (i=1.or.i=11.or.i=21.or.i=31.or.i=41.or.i=51.or.i=61)
fwrite(errhandle,[ ] )
endif
fwrite( errhandle,upper(alltrim(field_name)) )
skip
if (i=10.or.i=20.or.i=30.or.i=40.or.i=50.or.i=60)
fwrite(errhandle,[, ;]+&ret_line. )
else
fwrite(errhandle,[, ] )
endif
next
fwrite(errhandle,[ MyVAR ]+&ret_line. )
fwrite(errhandle,[ //]+&ret_line. )
fwrite(errhandle,[ // -> Abra os arquivos .DBF seguinte este exemplo]+&ret_line. )
//fwrite(errhandle,[ USE ]+upper(prg_name)+[ INDEX ]+upper(prg_name)+[ NEW SHARED ]+&ret_line. )
fwrite(errhandle,[ USE ]+lower(prg_name)+[ NEW SHARED ]+&ret_line. )
fwrite(errhandle,[ SELE ]+upper(prg_name)+&ret_line. )
fwrite(errhandle,[ CR_]+upper(prg_name)+[( "NOVO" )]+&ret_line. )
fwrite(errhandle,[ GO TOP]+&ret_line. )
fwrite(errhandle,' DEFINE FONT oFont[1] NAME "MS Sans Serif" SIZE 6,15'+&ret_line. )
fwrite(errhandle,' DEFINE FONT oFont[2] NAME "Helv" SIZE 6, 6'+&ret_line. )
fwrite(errhandle,' ACTIVATE FONT oFont[2] '+&ret_line. )
fwrite(errhandle,[ SET 3DLOOK ON]+&ret_line. )
fwrite(errhandle,[ DEFINE WINDOW oWnd TITLE "Reporting tools" MDI COLOR "N/W"]+&ret_line. )
fwrite(errhandle,[ SET MESSAGE OF oWnd TO "" CENTERED]+&ret_line. )
fwrite(errhandle,[ ACTIVATE WINDOW oWnd ON INIT ]+upper(prg_name)+[(oWnd) VALID MsgYesNo( "Deseja sair?" )]+&ret_line. )
fwrite(errhandle,[ CLOSE ALL]+&ret_line. )
fwrite(errhandle,[ return nil]+&ret_line. )
fwrite(errhandle,[]+&ret_line.)
fwrite(errhandle,[function ]+upper(prg_name)+[(oWnd)]+&ret_line. )
fwrite(errhandle,[ local oLbx]+&ret_line. )
fwrite(errhandle,[ DEFINE WINDOW oDlg TITLE "]+upper(prg_name)+[" MDICHILD OF oWnd]+&ret_line. )
fwrite(errhandle,[ DEFINE BUTTONBAR oBar OF oDlg SIZE 24,24 _3D]+&ret_line. )
fwrite(errhandle,[ @ 2, 1 LISTBOX oLbx ;]+&ret_line. )
fwrite(errhandle,[ FIELDS ] )
go top
quantas := recco()
for i = 1 to quantas
if (i=1.or.i=11.or.i=21.or.i=31.or.i=41.or.i=51.or.i=61)
fwrite(errhandle,[ ] )
endif
if field_type = 'N'
fwrite( errhandle,[STR( ]+upper(prg_name)+[->]+upper(alltrim(field_name))+[ )] )
else
if field_type = 'D'
fwrite( errhandle,[DTOC( ]+upper(prg_name)+[->]+upper(alltrim(field_name))+[ )] )
else
if field_type = 'L'
fwrite( errhandle,[IF( ]+upper(prg_name)+[->]+upper(alltrim(field_name))+[ ,'S','N' )] )
else
fwrite( errhandle,upper(prg_name)+[->]+upper(alltrim(field_name)) )
endif
endif
endif
skip
if (i=10.or.i=20.or.i=30.or.i=40.or.i=50.or.i=60)
fwrite(errhandle,[, ;]+&ret_line. )
else
if i # quantas
fwrite(errhandle,[, ] )
endif
endif
next
fwrite(errhandle,[ ; ]+&ret_line. )
fwrite(errhandle,[ HEADERS ] )
go top
quantas := recco()
for i = 1 to quantas
if (i=1.or.i=11.or.i=21.or.i=31.or.i=41.or.i=51.or.i=61)
fwrite(errhandle,[ ] )
endif
fwrite( errhandle,["]+upper(alltrim(field_name))+["] )
skip
if (i=10.or.i=20.or.i=30.or.i=40.or.i=50.or.i=60)
fwrite(errhandle,[, ;]+&ret_line. )
else
if i # quantas
fwrite(errhandle,[, ] )
endif
endif
next
fwrite(errhandle,[ ; ]+&ret_line. )
fwrite(errhandle,[ FIELDSIZES ] )
go top
quantas := recco()
for i = 1 to quantas
if (i=1.or.i=11.or.i=21.or.i=31.or.i=41.or.i=51.or.i=61)
fwrite(errhandle,[ ] )
endif
fwrite( errhandle,str(field_len*10,5) )
skip
if (i=10.or.i=20.or.i=30.or.i=40.or.i=50.or.i=60)
fwrite(errhandle,[, ;]+&ret_line. )
else
if i # quantas
fwrite(errhandle,[, ] )
endif
endif
next
fwrite(errhandle,[ ; ]+&ret_line. )
fwrite(errhandle,[ SIZE 20, 80 ;]+&ret_line.)
fwrite(errhandle,[ OF oDlg ;]+&ret_line.)
fwrite(errhandle,[ ON DBLCLICK EditClient( oLbx, "MOSTRA" )]+&ret_line.)
fwrite(errhandle,[]+&ret_line.)
fwrite(errhandle,[ oLbx:nLineStyle := 0 // no lines]+&ret_line.)
fwrite(errhandle,[ oLbx:bRClicked := { | nRow, nCol | ShowPopup( nRow, nCol, oLbx ) }]+&ret_line.)
fwrite(errhandle,[]+&ret_line.)
fwrite(errhandle,[ oDlg:SetControl( oLbx )]+&ret_line.)
fwrite(errhandle,[ oDlg:nStyle := 1]+&ret_line.)
fwrite(errhandle,[ ACTIVATE WINDOW oDlg VALID( oDlg := nil, .t. ) MAXIMIZED]+&ret_line.)
fwrite(errhandle,[ return nil]+&ret_line.)
fwrite(errhandle,[]+&ret_line.)
fwrite(errhandle,[]+&ret_line.)
fwrite(errhandle,[FUNCTION CR_]+upper(prg_name)+[( TIPO_ACAO )]+&ret_line.)
fwrite(errhandle,[ //]+&ret_line.)
fwrite(errhandle,[ // -> Carrega variaveis para entrada ou altercao de dados]+&ret_line.)
fwrite(errhandle,[ IF TIPO_ACAO = "NOVO"]+&ret_line.)
fwrite(errhandle,[ GOTO BOTT]+&ret_line.)
fwrite(errhandle,[ SKIP]+&ret_line.)
fwrite(errhandle,[ ENDIF]+&ret_line.)
go top
do while .not. eof()
fwrite(errhandle,[ M->]+upper(alltrim(field_name))+[ := ]+upper(prg_name)+[->]+upper(alltrim(field_name))+&ret_line.)
skip
enddo
fwrite(errhandle,[ IF TIPO_ACAO = "NOVO"]+&ret_line.)
fwrite(errhandle,[ //]+&ret_line.)
fwrite(errhandle,[ // -> Deficao de valores constantes]+&ret_line.)
fwrite(errhandle,[ ENDIF]+&ret_line.)
fwrite(errhandle,[ RETURN .T.]+&ret_line.)
fwrite(errhandle,[ ]+&ret_line.)
fwrite(errhandle,[FUNCTION SV_]+upper(prg_name)+&ret_line.)
fwrite(errhandle,[ //]+&ret_line.)
fwrite(errhandle,[ // -> Salva o conteudo das variaveis de entrada no arquivo]+&ret_line.)
go top
do while .not. eof()
fwrite(errhandle,[ ]+upper(prg_name)+[->]+upper(alltrim(field_name))+[ := M->]+upper(alltrim(field_name))+&ret_line.)
skip
enddo
fwrite(errhandle,[ COMMIT]+&ret_line.)
fwrite(errhandle,[ RETURN .T.]+&ret_line.)
fwrite(errhandle,[//----------------------------------------------------------------------------//]+&ret_line.)
fwrite(errhandle,[static function EditClient( oLbx, TIPO_ACAO )]+&ret_line.)
fwrite(errhandle,[ LOCAL oDlg1, oFld1, oFont1]+&ret_line.)
fwrite(errhandle,[ LOCAL ])
go top
quantas := recco()
for i = 1 to quantas
if (i=1.or.i=11.or.i=21.or.i=31.or.i=41.or.i=51.or.i=61)
fwrite(errhandle,[ ] )
endif
fwrite(errhandle,[ oGet]+strzero(i,2))
skip
if (i=10.or.i=20.or.i=30.or.i=40.or.i=50.or.i=60)
fwrite(errhandle,[, ;]+&ret_line. )
else
if i # quantas
fwrite(errhandle,[, ] )
endif
endif
next
fwrite(errhandle,&ret_line.)
fwrite(errhandle,[ LOCAL lSave := .f.]+&ret_line.)
fwrite(errhandle,[]+&ret_line.)
fwrite(errhandle,[ SELE ]+upper(prg_name)+&ret_line.)
fwrite(errhandle,[]+&ret_line.)
fwrite(errhandle,[ CR_]+upper(prg_name)+[( TIPO_ACAO )]+&ret_line.)
fwrite(errhandle,[]+&ret_line.)
fwrite(errhandle,[ DEFINE DIALOG oDlg1 RESOURCE "]+upper(prg_name)+[" TITLE "]+upper(prg_name)+["]+&ret_line. )
go top
quantas := recco()
for i = 1 to quantas
fwrite(errhandle,' REDEFINE GET oGet'+strzero(i,2)+' VAR M->'+upper(alltrim(field_name))+' ID ID_'+upper(alltrim(field_name))+' OF oDlg1 PICTURE "" MESSAGE ""'+&ret_line.)
skip
next
fwrite(errhandle,[ REDEFINE BUTTON ID 5001 OF oDlg1 ACTION ( lSave := .t. , oDlg1:End() )]+&ret_line.)
fwrite(errhandle,[ REDEFINE BUTTON ID 5002 OF oDlg1 ACTION ( lSave := .f. , oDlg1:End() )]+&ret_line.)
fwrite(errhandle,[]+&ret_line.)
fwrite(errhandle,[ ACTIVATE DIALOG oDlg1]+&ret_line.)
fwrite(errhandle,[ IF lSave = .T.]+&ret_line.)
fwrite(errhandle,[ IF TIPO_ACAO = "NOVO"]+&ret_line.)
fwrite(errhandle,[ APPEND BLANK]+&ret_line.)
fwrite(errhandle,[ ELSE]+&ret_line.)
fwrite(errhandle,[ RLOCK()]+&ret_line.)
fwrite(errhandle,[ ENDIF]+&ret_line.)
fwrite(errhandle,[ SV_]+upper(prg_name)+[()]+&ret_line.)
fwrite(errhandle,[ oLbx:Refresh()]+&ret_line.)
fwrite(errhandle,[ ENDIF]+&ret_line.)
fwrite(errhandle,[return nil]+&ret_line.)
fwrite(errhandle,[ ]+&ret_line.)
fwrite(errhandle,[//----------------------------------------------------------------------------//]+&ret_line.)
fwrite(errhandle,[static function ShowPopup( nRow, nCol, oLbx ) ]+&ret_line.)
fwrite(errhandle,[ local oPopup ]+&ret_line.)
fwrite(errhandle,[ MENU oPopup POPUP ]+&ret_line.)
fwrite(errhandle,[ MENUITEM "&Novo" ACTION EditClient( oLbx, "NOVO" ) ]+&ret_line.)
fwrite(errhandle,[ MENUITEM "&Editar" ACTION EditClient( oLbx, "MOSTRA" ) ]+&ret_line.)
fwrite(errhandle,[ MENUITEM "&Deletar" ACTION DelClient( oLbx ) ]+&ret_line.)
fwrite(errhandle,[ MENUITEM "&Pesquisar" ACTION SeekClient( oLbx ) ]+&ret_line.)
fwrite(errhandle,[ MENUITEM "Im&primir" ACTION oLbx:Report( "Listagem", .t. ) ]+&ret_line.)
fwrite(errhandle,[ SEPARATOR ]+&ret_line.)
fwrite(errhandle,[ MENUITEM "&Sair" ACTION oLbx:oWnd:End() ]+&ret_line.)
fwrite(errhandle,[ ENDMENU ]+&ret_line.)
fwrite(errhandle,[ ACTIVATE POPUP oPopup AT nRow, nCol OF oLbx ]+&ret_line.)
fwrite(errhandle,[return nil ]+&ret_line.)
fwrite(errhandle,[ ]+&ret_line.)
fwrite(errhandle,[//---------------------------------------------------------------------------// ]+&ret_line.)
fwrite(errhandle,[static function DelClient( oLbx ) ]+&ret_line.)
fwrite(errhandle,[ if MsgYesNo( "Tem certeza da exclusao deste registro?" ) ]+&ret_line.)
fwrite(errhandle,[ MsgRun( "Aguarde. Excluindo registro..." ) ]+&ret_line.)
fwrite(errhandle,[ RLOCK() ]+&ret_line.)
fwrite(errhandle,[ DELETE ]+&ret_line.)
fwrite(errhandle,[ COMMIT ]+&ret_line.)
fwrite(errhandle,[ MsgRun( "Atualizando esta listagem..." ) ]+&ret_line.)
fwrite(errhandle,[ oLbx:UpStable() // Corrige BUG no controle ]+&ret_line.)
fwrite(errhandle,[ oLbx:Refresh() // Refaz o listbox ]+&ret_line.)
fwrite(errhandle,[ endif ]+&ret_line.)
fwrite(errhandle,[return nil ]+&ret_line.)
fwrite(errhandle,[ ]+&ret_line.)
fwrite(errhandle,[//----------------------------------------------------------------------------//]+&ret_line.)
fwrite(errhandle,[static function SeekClient( oLbx ) ]+&ret_line.)
fwrite(errhandle,[ local cNombre := Space( 30 ) ]+&ret_line.)
fwrite(errhandle,[ local nRecNo := RecNo() ]+&ret_line.)
fwrite(errhandle,[ SET SOFTSEEK ON ]+&ret_line.)
fwrite(errhandle,[ if MsgGet( "Pesquisar", "Sigla", @cNombre, "bmp\lupa.bmp" ) ]+&ret_line.)
fwrite(errhandle,[ if ! DbSeek( cNombre ) ]+&ret_line.)
fwrite(errhandle,[ MsgAlert( "Sigla nao encontrada" ) ]+&ret_line.)
fwrite(errhandle,[ GO nRecNo ]+&ret_line.)
fwrite(errhandle,[ else ]+&ret_line.)
fwrite(errhandle,[ oLbx:UpStable() // Corrects same page stabilizing Bug ]+&ret_line.)
fwrite(errhandle,[ oLbx:Refresh() // Repaint the ListBox ]+&ret_line.)
fwrite(errhandle,[ endif ]+&ret_line.)
fwrite(errhandle,[ endif ]+&ret_line.)
fwrite(errhandle,[return nil ]+&ret_line.)
fclose(errhandle)
sele temp
use
select(ordarea)
RETURN
Algumas mensagens de alerta aparecerão em Ingles pois eu juntei vários utilitários Fivewin no mesmo código.
Como falei não é um aplicativo completissimo, mas tem utilidade para gerar codigos para uso e aprendizado.