Amiguinhos,
Seguindo a idéia do tópico DBU dentro da aplicação Clipper, encontrei um código muito interessante para colocar em uma aplicação Fivewin.
Levando-se em consideração que o quesito segurança relacionado ao nivel de acesso de usuários, este código deve ser utilizado somente pelo superuser ou administrador de seu sistema.
BrowserSuperUtil
DBU - Simulando dentro de sua aplicação Fivewin.
Moderador: Moderadores
-
rochinha
- Administrador
- Mensagens: 4664
- Registrado em: 18 Ago 2003 20:43
- Localização: São Paulo - Brasil
- Contato:
DBU - Simulando dentro de sua aplicação Fivewin.
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para [url=mailto://fivolution@hotmail.com]fivolution@hotmail.com[/url]. Agradecido.
@braços : ? )
A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
@braços : ? )
A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
-
rochinha
- Administrador
- Mensagens: 4664
- Registrado em: 18 Ago 2003 20:43
- Localização: São Paulo - Brasil
- Contato:
DBU - Simulando dentro de sua aplicação Fivewin.
Amiguinhos,
Fiz algumas alterações-zinhas:
- Correção da geração do .RC e do .PRG da tabela aberta.
- Aparecer nomes da tabela aberta no titulo da sub-janela.
- Abertura de tabelas em modo compartilhado.
- Abertura de tabelas .CDX.
O aplicativo não pretende suplantar nenhuma ferramenta estilo DBU, mas tem alguns comandos e funções bem básicas para enxertar em uma aplicação maior uma ferramenta muito util para manutenção de tabelas.
BrowserSuperUtilV2
Fiz algumas alterações-zinhas:
- Correção da geração do .RC e do .PRG da tabela aberta.
- Aparecer nomes da tabela aberta no titulo da sub-janela.
- Abertura de tabelas em modo compartilhado.
- Abertura de tabelas .CDX.
O aplicativo não pretende suplantar nenhuma ferramenta estilo DBU, mas tem alguns comandos e funções bem básicas para enxertar em uma aplicação maior uma ferramenta muito util para manutenção de tabelas.
BrowserSuperUtilV2
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para [url=mailto://fivolution@hotmail.com]fivolution@hotmail.com[/url]. Agradecido.
@braços : ? )
A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
@braços : ? )
A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
-
rochinha
- Administrador
- Mensagens: 4664
- Registrado em: 18 Ago 2003 20:43
- Localização: São Paulo - Brasil
- Contato:
DBU - Simulando dentro de sua aplicação Fivewin.
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):
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.
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):
Código: Selecionar todos
#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
Como falei não é um aplicativo completissimo, mas tem utilidade para gerar codigos para uso e aprendizado.
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para [url=mailto://fivolution@hotmail.com]fivolution@hotmail.com[/url]. Agradecido.
@braços : ? )
A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
@braços : ? )
A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
-
rochinha
- Administrador
- Mensagens: 4664
- Registrado em: 18 Ago 2003 20:43
- Localização: São Paulo - Brasil
- Contato:
DBU - Simulando dentro de sua aplicação Fivewin.
Amiguinhos,
Codigo completo(parte 2)
Codigo completo(parte 2)
Código: Selecionar todos
/*
* ******* ******* ******* ******* *
* Modulo de impressao dos relatorios
* ******* ******* ******* ******* *
*/
FUNCTION RPreview( oDevice )
LOCAL aFiles := oDevice:aMeta
LOCAL hOldRes := GetResources()
LOCAL oSay
LOCAL nFor
local oWndPRVMain := WndMain(), oIcon, oBar, oCursor, oPrwMenu, oBrush, oFont
local l97Look := oWndPRVMain != nil .and. oWndPRVMain:oBar != nil .and. ;
Len( oWndPRVMain:oBar:aControls ) > 0 .and. ;
oWndPRVMain:oBar:aControls[ 1 ]:l97Look
LOCAL lExit := .F.
local oHand
cResFile := "" // "Prev32.dll"
//IF SetResources(cResFile) < 32
// MsgStop(cResFile + " not found, imposible to continue",;
// "FiveWin Printing Error")
// RETU NIL
//ENDIF
IF oWndPRV != NIL
MsgStop(TXT_A_WINDOW_PREVIEW_IS_ALLREADY_RUNNING)
SetResources(hOldRes)
RETU NIL
ENDIF
if oWndPRVMain != nil
oIcon = oWndPRVMain:oIcon
endif
IF oDevice:lPrvModal .and. oWndPRVMain != NIL
oWndPRVMain:Hide()
ELSE
lExit := .T.
ENDIF
DEFINE FONT oFont NAME GetSysFont() SIZE 0,-12
DEFINE CURSOR oCursor RESOURCE "Lupa"
DEFINE WINDOW oWndPRV FROM 0, 0 TO 24, 80 ;
TITLE oDevice:cDocument ;
MENU BuildPrevMenu() ; //MDICHILD ;
COLOR CLR_BLACK,CLR_LIGHTGRAY ;
ICON oIcon ;
VSCROLL HSCROLL
oWndPRV:SetFont(oFont)
oWndPRV:oVScroll:SetRange(0,0)
oWndPRV:oHScroll:SetRange(0,0)
DEFINE CURSOR oHand HAND
//iif( LargeFonts(), 30, 26)
DEFINE BUTTONBAR oBar _3D SIZE 24, 24 OF oWndPRV
//DEFINE BUTTONBAR oBar _3D SIZE 32, 32 LEFT OF oWndPRV
oBar:bRClicked := {|| NIL }
if l97Look
DEFINE BUTTON RESOURCE "Top" OF oBar ;
MESSAGE TXT_GOTO_FIRST_PAGE ;
ACTION TopPage() ;
TOOLTIP Strtran(TXT_FIRST,"&","") NOBORDER
DEFINE BUTTON RESOURCE "Previous" OF oBar ;
MESSAGE TXT_GOTO_PREVIOUS_PAGE ;
ACTION PrevPage() ;
TOOLTIP Strtran(TXT_PREVIOUS,"&","") NOBORDER
DEFINE BUTTON RESOURCE "Next" OF oBar ;
MESSAGE TXT_GOTO_NEXT_PAGE ;
ACTION NextPage() ;
TOOLTIP Strtran(TXT_NEXT,"&","") NOBORDER
DEFINE BUTTON RESOURCE "Bottom" OF oBar ;
MESSAGE TXT_GOTO_LAST_PAGE ;
ACTION BottomPage() ;
TOOLTIP Strtran(TXT_LAST,"&","") NOBORDER
DEFINE BUTTON oZoom RESOURCE "Zoom" OF oBar GROUP ;
MESSAGE TXT_ZOOM_THE_PREVIEW ;
ACTION Zoom() ;
TOOLTIP Strtran(TXT_ZOOM,"&","") NOBORDER
DEFINE BUTTON oTwoPages RESOURCE "Two_Pages" OF oBar ;
MESSAGE TXT_PREVIEW_ON_TWO_PAGES ;
ACTION TwoPages() ;
TOOLTIP Strtran(TXT_TWOPAGES,"&","") NOBORDER
DEFINE BUTTON RESOURCE "Printer" OF oBar GROUP ;
MESSAGE TXT_PRINT_CURRENT_PAGE ;
ACTION PrintPage() ;
TOOLTIP Strtran(TXT_PRINT,"&","") NOBORDER
DEFINE BUTTON RESOURCE "Exit" OF oBar GROUP ;
MESSAGE TXT_EXIT_PREVIEW ;
ACTION (oWndPRV:minimize(),oWndPRV:cargo := NIL,oMeta1:End(),oMeta2:End(),oWndPRV:End()) ;
TOOLTIP Strtran(TXT_EXIT,"&","") NOBORDER
else
DEFINE BUTTON RESOURCE "Top" OF oBar ;
MESSAGE TXT_GOTO_FIRST_PAGE ;
ACTION TopPage() ;
TOOLTIP Strtran(TXT_FIRST,"&","")
DEFINE BUTTON RESOURCE "Previous" OF oBar ;
MESSAGE TXT_GOTO_PREVIOUS_PAGE ;
ACTION PrevPage() ;
TOOLTIP Strtran(TXT_PREVIOUS,"&","")
DEFINE BUTTON RESOURCE "Next" OF oBar ;
MESSAGE TXT_GOTO_NEXT_PAGE ;
ACTION NextPage() ;
TOOLTIP Strtran(TXT_NEXT,"&","")
DEFINE BUTTON RESOURCE "Bottom" OF oBar ;
MESSAGE TXT_GOTO_LAST_PAGE ;
ACTION BottomPage() ;
TOOLTIP Strtran(TXT_LAST,"&","")
DEFINE BUTTON oZoom RESOURCE "Zoom" OF oBar GROUP ;
MESSAGE TXT_ZOOM_THE_PREVIEW ;
ACTION Zoom() ;
TOOLTIP Strtran(TXT_ZOOM,"&","")
DEFINE BUTTON oTwoPages RESOURCE "Two_Pages" OF oBar ;
MESSAGE TXT_PREVIEW_ON_TWO_PAGES ;
ACTION TwoPages() ;
TOOLTIP Strtran(TXT_TWOPAGES,"&","")
DEFINE BUTTON RESOURCE "Printer" OF oBar GROUP ;
MESSAGE TXT_PRINT_CURRENT_PAGE ;
ACTION PrintPage() ;
TOOLTIP Strtran(TXT_PRINT,"&","")
DEFINE BUTTON RESOURCE "Exit" OF oBar GROUP ;
MESSAGE TXT_EXIT_PREVIEW ;
ACTION (oWndPRV:minimize(),oWndPRV:cargo := NIL,oMeta1:End(),oMeta2:End(),oWndPRV:End()) ;
TOOLTIP Strtran(TXT_EXIT,"&","")
endif
DEFINE BUTTON oBarPGNum PROMPT "" OF oBar GROUP NOBORDER
AEval( oBar:aControls, { | o | o:oCursor := oHand } )
SET MESSAGE OF oWndPRV TO TXT_PREVIEW CENTERED ;
NOINSET CLOCK DATE KEYBOARD
oMeta1 := TMetaFile():New( 0, 0, 0, 0,;
aFiles[1],;
oWndPRV,;
CLR_BLACK,;
CLR_WHITE,;
oDevice:nHorzRes(),;
oDevice:nVertRes() )
oMeta1:oCursor := oCursor
oMeta1:blDblClick := { |nRow, nCol, nKeyFlags| ;
SetOrg1( nCol, nRow, nKeyFlags ) }
oMeta1:bKeyDown := {|nKey,nFlags| CheckKey(nKey,nFlags)}
#ifndef __XPP__ // XBPP bug. Warning: don't change this into #ifdef __CLIPPER__
oMeta2 := TMetaFile():New( 0,0,0,0,"",;
oWndPRV,CLR_BLACK,CLR_WHITE,oDevice:nHorzRes(),;
oDevice:nVertRes())
#else
oMeta2 := TMetaFile():New():_New( 0,0,0,0,"",;
oWndPRV,CLR_BLACK,CLR_WHITE,oDevice:nHorzRes(),;
oDevice:nVertRes())
#endif
oMeta2:oCursor := oCursor
oMeta2:blDblClick := {|nRow, nCol, nKeyFlags| ;
SetOrg2(nCol, nRow, nKeyFlags)}
oMeta2:hide()
nPage := 1
nZFactor := 1
lTwoPages := .F.
lZoom := .F.
@ 7, 275 SAY oSay PROMPT TXT_FACTOR ;
SIZE 60, 15 PIXEL OF oBar FONT oFont
@ 3, 325 COMBOBOX oFactor VAR nZFactor ;
ITEMS {"1","2","3","4","5","6","7","8","9"} ;
OF oBar FONT oFont PIXEL SIZE 35,200 ;
ON CHANGE SetFactor(nZFactor)
//@ 7, 370 SAY oPAGE PROMPT TXT_PAGENUM+ltrim(str(nPage,4)) ;
// SIZE 180, 15 PIXEL OF oBar FONT oFont
oFactor:Set3dLook()
oWndPRV:cargo := oDevice
WndCenter(oWndPRV:hWnd)
SysRefresh()
SetResources(hOldRes)
oWndPRV:oHScroll:bPos := {|nPos| hScroll(GO_POS, .f., nPos)}
oWndPRV:oVScroll:bPos := {|nPos| vScroll(GO_POS, .f., nPos)}
SetFactor()
ACTIVATE WINDOW oWndPRV ;
MAXIMIZED ;
ON RESIZE PaintMeta() ;
ON UP vScroll(GO_UP) ;
ON DOWN vScroll(GO_DOWN) ;
ON PAGEUP vScroll(GO_UP,GO_PAGE) ;
ON PAGEDOWN vScroll(GO_DOWN,GO_PAGE) ;
ON LEFT hScroll(GO_LEFT) ;
ON RIGHT hScroll(GO_RIGHT) ;
ON PAGELEFT hScroll(GO_LEFT,GO_PAGE) ;
ON PAGERIGHT hScroll(GO_RIGHT,GO_PAGE) ;
VALID (oWndPRV:oIcon := NIL ,;
oWndPRV:minimize() ,;
oWndPRV:cargo := NIL ,;
oFont:End() ,;
oMeta1:End() ,;
oMeta2:End() ,;
oDevice:End() ,;
oHand:End() ,;
oWndPRV := NIL ,;
lExit := .T. ,;
.T.)
StopUntil( {|| lExit} )
IF oDevice:lPrvModal .and. oWndPRVMain != NIL
oWndPRVMain:Show()
ENDIF
Return (NIL)
//----------------------------------------------------------------------------//
STATIC FUNCTION BuildPrevMenu()
LOCAL nFor, oPrwMenu
aFactor := Array(9)
MENU oPrwMenu
MENUITEM TXT_FILE
MENU
MENUITEM TXT_PRINT ACTION PrintPage() ;
MESSAGE TXT_PRINT_CURRENT_PAGE RESOURCE "Printer"
SEPARATOR
MENUITEM TXT_EXIT ACTION oWndPRV:End() ;
MESSAGE TXT_EXIT_PREVIEW RESOURCE "Exit"
ENDMENU
MENUITEM TXT_PAGE
MENU
MENUITEM TXT_FIRST ACTION TopPage() ;
MESSAGE TXT_GOTO_FIRST_PAGE RESOURCE "Top"
MENUITEM TXT_PREVIOUS ACTION PrevPage() ;
MESSAGE TXT_GOTO_PREVIOUS_PAGE RESOURCE "Previous"
MENUITEM TXT_NEXT ACTION NextPage() ;
MESSAGE TXT_GOTO_NEXT_PAGE RESOURCE "Next"
MENUITEM TXT_LAST ACTION BottomPage() ;
MESSAGE TXT_GOTO_LAST_PAGE RESOURCE "Bottom"
SEPARATOR
MENUITEM oMenuZoom PROMPT TXT_ZOOM ACTION Zoom(.T.) ;
ENABLED ;
MESSAGE TXT_ZOOM_THE_PREVIEW RESOURCE "Zoom"
MENUITEM oMenuUnZoom PROMPT TXT_UNZOOM ACTION Zoom(.T.) ;
DISABLED ;
MESSAGE TXT_UNZOOM_THE_PREVIEW RESOURCE "UnZoom"
MENUITEM "&Factor" MESSAGE TXT_ZOOM_FACTOR
MENU
FOR nFor := 1 TO len(aFactor)
MENUITEM aFactor[nFor] ;
PROMPT "&"+ltrim(str(nFor)) ;
MESSAGE "Factor "+ltrim(str(nFor)) ;
ACTION (oFactor:Set(oMenuItem:nHelpId),;
oFactor:Change() )
NEXT
ENDMENU
SEPARATOR
MENUITEM oMenuTwoPages PROMPT TXT_TWOPAGES ACTION TwoPages(.T.) ;
ENABLED ;
MESSAGE TXT_PREVIEW_ON_TWO_PAGES RESOURCE "Two_Pages"
MENUITEM oMenuOnePage PROMPT TXT_ONEPAGE ACTION TwoPages(.T.) ;
DISABLED ;
MESSAGE TXT_PREVIEW_ON_ONE_PAGE RESOURCE "One_Page"
ENDMENU
ENDMENU
return oPrwMenu
//----------------------------------------------------------------------------//
STATIC Function PaintMeta()
LOCAL oCoors1, oCoors2
LOCAL aFiles := DEVICE:aMeta
LOCAL nWidth, nHeight, nFactor
IF IsIconic(oWndPRV:hWnd)
RETU NIL
ENDIF
DO CASE
CASE !lTwoPages
IF !lZoom
IF DEVICE:nHorzSize() >= ; // Apaisado
DEVICE:nVertSize()
nFactor := .4
ELSE
nFactor := .25
ENDIF
ELSE
nFactor := .47
ENDIF
nWidth := oWndPRV:nRight-oWndPRV:nLeft+1 - iif(lZoom,20 ,0 )
nHeight := oWndPRV:nBottom-oWndPRV:nTop+1 - iif(lZoom,20 ,0 )
oCoors1 := TRect():New(50,;
nWidth/2-(nWidth*nFactor),;
nHeight-iif( largefonts(),100 , 80),;
nWidth/2+(nWidth*nFactor))
oMeta2:Hide()
oMeta1:SetCoors(oCoors1)
CASE lTwoPages
nFactor := .4
aFiles := DEVICE:aMeta
nWidth := oWndPRV:nRight-oWndPRV:nLeft+1
nHeight := oWndPRV:nBottom-oWndPRV:nTop+1
oCoors1 := TRect():New(50,;
(nWidth/4)-((nWidth/2)*nFactor),;
nHeight-iif( largefonts(),100 , 80),;
(nWidth/4)+((nWidth/2)*nFactor))
oCoors2 := TRect():New(50,;
(nWidth/4)-((nWidth/2)*nFactor)+(nWidth/2),;
nHeight-iif( largefonts(),100 , 80),;
(nWidth/4)+((nWidth/2)*nFactor)+(nWidth/2))
IF nPage == Len(aFiles)
oMeta2:SetFile("")
ELSE
oMeta2:SetFile(aFiles[nPage+1])
ENDIF
oMeta1:SetCoors(oCoors1)
oMeta2:SetCoors(oCoors2)
oMeta2:Show()
ENDCASE
oMeta1:SetFocus()
RETURN NIL
//----------------------------------------------------------------------------//
STATIC Function NextPage()
LOCAL hOldRes := GetResources()
LOCAL aFiles := DEVICE:aMeta
IF nPage == len(aFiles)
MessageBeep()
RETU NIL
ENDIF
nPage++
//set resources to cResFile
oMeta1:SetFile(aFiles[nPage])
//oPage:SetText(TXT_PAGENUM+ltrim(str(nPage,4,0))+" / "+ltrim(str(len(aFiles))))
oBarPGNum:cCaption := alltrim(ltrim(str(nPage,2,0))+"/"+ltrim(str(len(aFiles))))
oBarPGNum:Refresh()
oMeta1:Refresh()
IF lTwoPages
IF len(aFiles) >= (nPage+1)
oMeta2:SetFile(aFiles[nPage+1])
ELSE
oMeta2:SetFile("")
ENDIF
oMeta2:Refresh()
ENDIF
oMeta1:SetFocus()
SetResources(hOldRes)
RETURN NIL
//----------------------------------------------------------------------------//
STATIC Function PrevPage()
LOCAL hOldRes := GetResources()
LOCAL aFiles := DEVICE:aMeta
IF nPage == 1
MessageBeep()
RETU NIL
ENDIF
nPage--
//set resources to cResFile
oMeta1:SetFile(aFiles[nPage])
//oPage:SetText(TXT_PAGENUM+ltrim(str(nPage,4,0))+" / "+ltrim(str(len(aFiles))))
oBarPGNum:cCaption := alltrim(ltrim(str(nPage,2,0))+"/"+ltrim(str(len(aFiles))))
oBarPGNum:Refresh()
oMeta1:Refresh()
IF lTwoPages
IF len(aFiles) >= nPage+1
oMeta2:SetFile(aFiles[nPage+1])
ELSE
oMeta2:SetFile("")
ENDIF
oMeta2:Refresh()
ENDIF
oMeta1:SetFocus()
SetResources(hOldRes)
RETURN NIL
//----------------------------------------------------------------------------//
STATIC Function TopPage()
LOCAL hOldRes := GetResources()
LOCAL aFiles := DEVICE:aMeta
IF nPage == 1
MessageBeep()
RETU NIL
ENDIF
nPage := 1
//set resources to cResFile
oMeta1:SetFile(aFiles[nPage])
//oPage:SetText(TXT_PAGENUM+ltrim(str(nPage,4,0))+" / "+ltrim(str(len(aFiles))))
oBarPGNum:cCaption := alltrim(ltrim(str(nPage,2,0))+"/"+ltrim(str(len(aFiles))))
oBarPGNum:Refresh()
oMeta1:Refresh()
IF lTwoPages
IF len(aFiles) >= nPage+1
oMeta2:SetFile(aFiles[nPage+1])
ELSE
oMeta2:SetFile("")
ENDIF
oMeta2:Refresh()
ENDIF
oMeta1:SetFocus()
SetResources(hOldRes)
RETURN NIL
//----------------------------------------------------------------------------//
STATIC Function BottomPage()
LOCAL hOldRes := GetResources()
LOCAL aFiles := DEVICE:aMeta
IF nPage == len(aFiles)
MessageBeep()
RETU NIL
ENDIF
nPage := len(aFiles)
//set resources to cResFile
oMeta1:SetFile(aFiles[nPage])
//oPage:SetText(TXT_PAGENUM+ltrim(str(nPage,4,0))+" / "+ltrim(str(len(aFiles))))
oBarPGNum:cCaption := alltrim(ltrim(str(nPage,2,0))+"/"+ltrim(str(len(aFiles))))
oBarPGNum:Refresh()
oMeta1:Refresh()
IF lTwoPages
oMeta2:SetFile("")
oMeta2:Refresh()
ENDIF
oMeta1:SetFocus()
SetResources(hOldRes)
RETURN NIL
//----------------------------------------------------------------------------//
STATIC FUNCTION TwoPages(lMenu)
LOCAL hOldRes := GetResources()
//set resources to cResFile
DEFAULT lMenu := .F.
lTwoPages := !lTwoPages
IF lTwoPages
IF len(DEVICE:aMeta) == 1 // solo hay una pagina
lTwoPages := !lTwoPages
MessageBeep()
SetResources(hOldRes)
RETU NIL
ENDIF
IF DEVICE:nHorzSize() >= ; // Apaisado
DEVICE:nVertSize()
lTwoPages := !lTwoPages
MessageBeep()
SetResources(hOldRes)
RETU NIL
ENDIF
IF lZoom
Zoom(.T.)
ENDIF
oTwoPages:FreeBitmaps()
oTwoPages:LoadBitmaps("One_Page")
oTwoPages:cMsg := TXT_PREVIEW_ON_ONE_PAGE
oTwoPages:cTooltip := StrTran(TXT_ONEPAGE,"&","")
oMenuTwoPages:disable()
oMenuOnePage:enable()
ELSE
oTwoPages:FreeBitmaps()
oTwoPages:LoadBitmaps("Two_Pages")
oTwoPages:cMsg := TXT_PREVIEW_ON_TWO_PAGES
oTwoPages:cTooltip := StrTran(TXT_TWOPAGES,"&","")
oMenuTwoPages:enable()
oMenuOnePage:disable()
ENDIF
IF lMenu
oTwoPages:Refresh()
ENDIF
oWndPRV:Refresh()
PaintMeta()
SetResources(hOldRes)
RETURN NIL
//----------------------------------------------------------------------------//
STATIC FUNCTION Zoom(lMenu)
LOCAL hOldRes := GetResources()
//set resources to cResFile
DEFAULT lMenu := .F.
lZoom := !lZoom
IF lZoom
IF lTwoPages
TwoPages(.T.)
ENDIF
oZoom:FreeBitmaps()
oZoom:LoadBitmaps("Unzoom")
oZoom:cMsg := TXT_UNZOOM_THE_PREVIEW
oZoom:cTooltip := StrTran(TXT_UNZOOM,"&","")
oMenuZoom:disable()
oMenuUnZoom:enable()
oWndPRV:oVScroll:SetRange(1,VSCROLL_RANGE)
oWndPRV:oHScroll:SetRange(1,HSCROLL_RANGE)
oMeta1:ZoomIn()
ELSE
oZoom:FreeBitmaps()
oZoom:LoadBitmaps("Zoom")
oZoom:cMsg := TXT_ZOOM_THE_PREVIEW
oZoom:cTooltip := StrTran(TXT_ZOOM,"&","")
oMenuZoom:enable()
oMenuUnZoom:disable()
oWndPRV:oVScroll:SetRange(0,0)
oWndPRV:oHScroll:SetRange(0,0)
oMeta1:ZoomOut()
ENDIF
IF lMenu
oZoom:Refresh()
ENDIF
PaintMeta()
SetResources(hOldRes)
RETURN NIL
//----------------------------------------------------------------------------//
STATIC FUNCTION VScroll(nType,lPage, nSteps)
LOCAL nYfactor, nYorig, nStep
DEFAULT lPage := .F.
nYfactor := Int(DEVICE:nVertRes()/oWndPRV:oVScroll:nMax)
IF nSteps != NIL
nStep := nSteps
ELSEIF lPage
nStep := oWndPRV:oVScroll:nMax/10
ELSE
nStep := 1
ENDIF
IF nType == GO_UP
nStep := -(nStep)
ELSEIF nType == GO_POS
oWndPRV:oVscroll:SetPos(nSteps)
nStep := 0
ENDIF
nYorig := nYfactor * (oWndPRV:oVScroll:GetPos() + nStep - 1)
IF nYorig > DEVICE:nVertRes()
nYorig := DEVICE:nVertRes()
ENDIF
IF nYorig < 0
nYorig := 0
ENDIF
oMeta1:SetOrg(NIL,nYorig)
oMeta1:Refresh()
RETURN NIL
//----------------------------------------------------------------------------//
STATIC FUNCTION HScroll(nType,lPage, nSteps)
LOCAL nXfactor, nXorig, nStep
DEFAULT lPage := .F.
nXfactor := Int(DEVICE:nHorzRes()/oWndPRV:oHScroll:nMax)
IF nSteps != NIL
nStep := nSteps
ELSEIF lPage
nStep := oWndPRV:oHScroll:nMax/10
ELSE
nStep := 1
ENDIF
IF nType == GO_LEFT
nStep := -(nStep)
ELSEIF nType == GO_POS
oWndPRV:oHscroll:SetPos(nSteps)
nStep := 0
ENDIF
nXorig := nXfactor * (oWndPRV:oHScroll:GetPos() + nStep - 1)
IF nXorig > DEVICE:nHorzRes()
nXorig := DEVICE:nHorzRes()
ENDIF
IF nXorig < 0
nXorig := 0
ENDIF
oMeta1:SetOrg(nXorig,NIL)
oMeta1:Refresh()
RETURN NIL
//----------------------------------------------------------------------------//
STATIC FUNCTION SetOrg1(nX, nY)
LOCAL oCoors
LOCAL nXStep, nYStep, nXFactor, nYFactor,;
nWidth, nHeight, nXOrg
IF lZoom
Zoom(.T.)
RETU NIL
ENDIF
oCoors := oMeta1:GetRect()
nWidth := oCoors:nRight - oCoors:nLeft + 1
nHeight := oCoors:nBottom - oCoors:nTop + 1
nXStep := Max(Int(nX/nWidth*HSCROLL_RANGE) - 9, 0)
nYStep := Max(Int(nY/nHeight*VSCROLL_RANGE) - 9, 0)
nXFactor := Int(DEVICE:nHorzRes()/HSCROLL_RANGE)
nYFactor := Int(DEVICE:nVertRes()/VSCROLL_RANGE)
Zoom(.T.)
IF !empty(nXStep)
HScroll(2,,nxStep)
oWndPRV:oHScroll:SetPos(nxStep)
ENDIF
IF !empty(nYStep)
VScroll(2,,nyStep)
oWndPRV:oVScroll:SetPos(nyStep)
ENDIF
RETURN NIL
//----------------------------------------------------------------------------//
STATIC FUNCTION SetOrg2(nX, nY)
LOCAL oCoors
LOCAL aFiles
LOCAL nXStep, nYStep, nXFactor, nYFactor,;
nWidth, nHeight, nXOrg
IF oMeta2:cCaption == ""
RETU NIL
ENDIF
IF lZoom
Zoom(.T.)
RETU NIL
ENDIF
oCoors := oMeta2:GetRect()
nWidth := oCoors:nRight - oCoors:nLeft + 1
nHeight := oCoors:nBottom - oCoors:nTop + 1
nXStep := Max(Int(nX/nWidth*HSCROLL_RANGE) - 9, 0)
nYStep := Max(Int(nY/nHeight*VSCROLL_RANGE) - 9, 0)
nXFactor := Int(DEVICE:nHorzRes()/HSCROLL_RANGE)
nYFactor := Int(DEVICE:nVertRes()/VSCROLL_RANGE)
oMeta1:SetFile(oMeta2:cCaption)
aFiles := DEVICE:aMeta
IF nPage = len(aFiles)
oMeta2:SetFile("")
ELSE
oMeta2:SetFile(aFiles[++nPage])
ENDIF
//oPage:Refresh()
oBarPGNum:Refresh()
Zoom(.T.)
IF !empty(nXStep)
HScroll(2,,nxStep)
oWndPRV:oHScroll:SetPos(nxStep)
ENDIF
IF !empty(nYStep)
VScroll(2,,nyStep)
oWndPRV:oVScroll:SetPos(nyStep)
ENDIF
RETURN NIL
//----------------------------------------------------------------------------//
STATIC FUNCTION CheckKey (nKey,nFlags) // Thanks to Joerg K.
IF !lZoom
DO CASE
CASE nKey == VK_HOME
TopPage()
CASE nKey == VK_END
BottomPage()
CASE nKey == VK_PRIOR
PrevPage()
CASE nKey == VK_NEXT
NextPage()
ENDCASE
ELSE
DO CASE
CASE nKey == VK_UP
oWndPRV:oVScroll:GoUp()
CASE nKey == VK_PRIOR
oWndPRV:oVScroll:PageUp()
CASE nKey == VK_DOWN
oWndPRV:oVScroll:GoDown()
CASE nKey == VK_NEXT
oWndPRV:oVScroll:PageDown()
CASE nKey == VK_LEFT
oWndPRV:oHScroll:GoUp()
CASE nKey == VK_RIGHT
oWndPRV:oHScroll:GoDown()
CASE nKey == VK_HOME
oWndPRV:oVScroll:GoTop()
oWndPRV:oHScroll:GoTop()
oMeta1:SetOrg(0,0)
oMeta1:Refresh()
CASE nKey == VK_END
oWndPRV:oVScroll:GoBottom()
oWndPRV:oHScroll:GoBottom()
oMeta1:SetOrg(.8*DEVICE:nHorzRes(),.8*DEVICE:nVertRes())
oMeta1:Refresh()
ENDCASE
ENDIF
RETURN NIL
//----------------------------------------------------------------------------//
STATIC FUNCTION SetFactor(nValue)
LOCAL lInit := .F.
IF nValue == NIL
Aeval(aFactor, {|v,e| v:nHelpId := e})
nValue := nZFactor
lInit := .T.
ENDIF
Aeval(aFactor, {|val,elem| val:SetCheck( (elem == nZFactor) ) })
oMeta1:SetZoomFactor(nZFactor, nZFactor*2)
IF !lZoom .AND. !lInit
Zoom(.T.)
ENDIF
IF lZoom
oWndPRV:oVScroll:SetRange(1,VSCROLL_RANGE)
oWndPRV:oHScroll:SetRange(1,HSCROLL_RANGE)
ENDIF
oMeta1:SetFocus()
RETURN NIL
//----------------------------------------------------------------------------//
STATIC Function PrintPage()
LOCAL hOldRes := GetResources()
LOCAL hMeta := oMeta1:hMeta
LOCAL oDlg, oRad, oPageIni, oPageFin
LOCAL nOption := 1 ,;
nFirst := 1 ,;
nLast := len(DEVICE:aMeta)
IF nLast == 1
PrintPrv(NIL, nOption, nFirst, nLast)
RETU NIL
ENDIF
//set resources to cResFile
DEFINE DIALOG oDlg RESOURCE "PRINT"
REDEFINE BUTTON ID 101 OF oDlg ;
ACTION PrintPrv(oDlg, nOption, nFirst, nLast)
REDEFINE BUTTON ID 102 OF oDlg ACTION oDlg:End()
REDEFINE RADIO oRad VAR nOption ID 103,104,105 OF oDlg ;
ON CHANGE iif(nOption==3 ,;
(oPageIni:Enable(),oPageFin:Enable()) ,;
(oPageIni:Disable(),oPageFin:Disable()) )
REDEFINE GET oPageIni ;
VAR nFirst ;
ID 106 ;
PICTURE "@K 99999" ;
VALID iif(nFirst<1 .OR. nFirst>nLast,(MessageBeep(),.F.),.T.) ;
OF oDlg
REDEFINE GET oPageFin ;
VAR nLast ;
ID 107 ;
PICTURE "@K 99999" ;
VALID iif(nLast<nFirst .OR. nLast>len(DEVICE:aMeta), ;
(MessageBeep(),.F.),.T.) ;
OF oDlg
oPageIni:Disable()
oPageFin:Disable()
SetResources(hOldRes )
ACTIVATE DIALOG oDlg
RETURN NIL
//----------------------------------------------------------------------------//
STATIC FUNCTION PrintPrv(oDlg, nOption, nPageIni, nPageEnd)
Local oDevice := DEVICE
LOCAL aFiles := oDevice:aMeta
LOCAL hMeta := oMeta1:hMeta
LOCAL nFor
CursorWait()
StartDoc(oDevice:hDC, oDevice:cDocument )
DO CASE
CASE nOption == 1 // All
FOR nFor := 1 TO len(aFiles)
StartPage(oDevice:hDC)
hMeta := GetMetaFile(aFiles[nFor])
PlayMetaFile( oDevice:hDC, hMeta )
DeleteMetafile(hMeta)
EndPage(oDevice:hDC)
NEXT
CASE nOption == 2 // Current page
StartPage(oDevice:hDC)
hMeta := oMeta1:hMeta
PlayMetaFile( oDevice:hDC, hMeta )
EndPage(oDevice:hDC)
CASE nOption == 3 // Range
FOR nFor := nPageIni TO nPageEnd
StartPage(oDevice:hDC)
hMeta := GetMetaFile(aFiles[nFor])
PlayMetaFile( oDevice:hDC, hMeta )
DeleteMetafile(hMeta)
EndPage(oDevice:hDC)
NEXT
ENDCASE
EndDoc(oDevice:hDC)
CursorArrow()
IF oDlg != NIL
oDlg:End()
ENDIF
RETURN NIL
/*
* ******* ******* ******* *******
* Modulo de criacao de formularios
* ******* ******* ******* *******
*/
function GenFM()
local oBmp, oGFBar
local cLabel := Space( 30 )
local lTest := .f.
public oGFWnd
public cModName := " "
SetGridSize( 1, 1 )
if ! File( "scanned.dbf" )
DbCreate( "scanned", { { "nome" , "C", 15, 0 },;
{ "descricao", "C", 75, 0 },;
{ "imagem" , "C", 25, 0 } } )
endif
if ! File( "ScanInfo.dbf" )
DbCreate( "ScanInfo", { { "nome" , "C", 15, 0 },;
{ "ordem" , "N", 3, 0 },;
{ "linha" , "N", 4, 0 },;
{ "Coluna" , "N", 4, 0 },;
{ "Expressao", "C", 25, 0 },;
{ "tipo" , "C", 3, 0 },;
{ "largura" , "N", 4, 0 },;
{ "altura" , "N", 4, 0 } } )
endif
if ! File( "ScanInfo.cdx" )
USE ScanInfo
INDEX ON Field->nome + StrZero( Field->ordem, 3 ) to ScanInfo
USE
endif
USE Scanned NEW SHARED
USE ScanInfo NEW SHARED INDEX ScanInfo
DEFINE WINDOW oGFWnd TITLE "Contracts" MDICHILD
DEFINE BUTTONBAR oGFBar OF oGFWnd SIZE 24,24 _3D
DEFINE BUTTON OF oGFBar RESOURCE "BTNOpen" ;
NOBORDER TOOLTIP "Formulario" ACTION LoadData( oBmp )
DEFINE BUTTON OF oGFBar GROUP RESOURCE "BTNEdit" ;
NOBORDER TOOLTIP "Descricao" ACTION MsgGet( "Descripción",;
"Texto", @cLabel )
DEFINE BUTTON OF oGFBar GROUP RESOURCE "BTNTexto" ;
NOBORDER TOOLTIP "Texto" ACTION PoeTexto( oBmp )
DEFINE BUTTON OF oGFBar RESOURCE "BTNGet" ;
NOBORDER TOOLTIP "Campo GET" ACTION PoeGet( oBmp )
DEFINE BUTTON OF oGFBar RESOURCE "BTNCheck" ;
NOBORDER TOOLTIP "Checkbox" ACTION PoeCheck( oBmp )
DEFINE BUTTON OF oGFBar RESOURCE "BTNBitmap" ;
NOBORDER TOOLTIP "Bitmap" ACTION PoeBitmap( oBmp )
DEFINE BUTTON OF oGFBar GROUP RESOURCE "BTNView" ;
NOBORDER TOOLTIP "Executar" ACTION lTest := ! lTest,;
AEval( oBmp:aControls, { | o | o:lDrag := .f. } ),;
MsgInfo( "Action" )
DEFINE BUTTON OF oGFBar RESOURCE "BTNprint" ;
NOBORDER TOOLTIP "Imprimir" ACTION imprimirBmp( cModName, oBmp )
DEFINE BUTTON OF oGFBar RESOURCE "BTNSave" ;
NOBORDER TOOLTIP "Salvar" ACTION Guardar( oBmp )
DEFINE BUTTON OF oGFBar GROUP RESOURCE "BTNexit" ;
ACTION oGFWnd:End() NOBORDER TOOLTIP "Terminar"
@ 2, 0 BITMAP oBmp FILENAME Scanned->Imagem OF oGFWnd SCROLL
oBmp:SetColor( "N/W*" )
oGFWnd:oClient = oBmp
oBmp:nVStep = 20
oBmp:nHStep = 20
oBmp:aControls = {}
oBmp:oVScroll:bGoDown = { || If( oBmp:nX > -oBmp:nXExtra(),;
AEval( oBmp:aControls,;
{ | o | o:nTop -= 20 } ),) }
oBmp:oVScroll:bGoUp = { || If( oBmp:nX != 0,;
AEval( oBmp:aControls,;
{ | o | o:nTop += 20 } ),) }
ACTIVATE WINDOW oGFWnd MAXIMIZED VALID (dbCloseAll(), .t.)
return nil
function PoeTexto( oBmp )
local oSay
@ 10, 10 SAY oSay PROMPT "Etiqueta" SIZE 120, 20 PIXEL OF oBmp COLOR "N/W" DESIGN
oSay:bRClicked = { | nRow, nCol | LabelInspect( oSay, nRow, nCol ) }
oSay:SetFocus()
return nil
function PoeGet( oBmp )
local oGet, cText := Space( 30 )
@ 10, 10 GET oGet VAR cText SIZE 120, 20 PIXEL OF oBmp COLOR "N/W" DESIGN
oGet:bRClicked = { | nRow, nCol | LabelInspect( oGet, nRow, nCol ) }
oGet:SetFocus()
return nil
function PoeCheck( oBmp )
local lValue := .t.
@ 10, 10 CHECKBOX lValue PROMPT "" SIZE 12, 12 ;
PIXEL OF oBmp COLOR "N/W" DESIGN
return nil
function PoeBitmap( oBmp )
local oCTBmp, cBmpFile := cGetFile( "*.bmp", "Selecione um bitmap" )
if File( cBmpFile )
@ 3, 2 BITMAP oCTBmp SIZE 20,20 FILENAME cBmpFile OF oBmp DESIGN
oCTBmp:SetFocus()
endif
return nil
function LabelInspect( oSay, nRow, nCol )
local oMenu
MENU oMenu POPUP
MENUITEM "&Colors..." ACTION oSay:SelColor()
MENUITEM "&Font..." ACTION oSay:SelFont()
ENDMENU
ACTIVATE MENU oMenu AT nRow, nCol OF oSay
return nil
function Guardar( oBmp )
local n
cModName := "teste.bmp"
if ! MsgGet( "Nome do formulario:", "Name", @cModName )
return nil
endif
oGFWnd:SetText( "Form - " + cModName )
if File( cModName + ".dbf" )
if ! MsgYesNo( "That file already exists. Overwrite it ?" )
return nil
endif
endif
//DbCreate( cModName, { { "name", "C", 15, 0 },;
// { "order", "N", 3, 0 },;
// { "Row", "N", 4, 0 },;
// { "Col", "N", 4, 0 },;
// { "Expr", "C", 25, 0 },;
// { "type", "C", 3, 0 },;
// { "width", "N", 4, 0 },;
// { "height", "N", 4, 0 } } )
dbSelectArea( "scanned" )
dbAppend()
scanned->nome := cFileName(cModName)
scanned->descricao := ""
scanned->imagem := cModName
dbRUnlock()
dbCommit()
dbSelectArea( "scaninfo" )
for n = 1 to Len( oBmp:aControls )
dbAppend()
scaninfo->nome := cModName
scaninfo->ordem := n
scaninfo->linha := oBmp:aControls[ n ]:nTop
scaninfo->Coluna := oBmp:aControls[ n ]:nLeft
scaninfo->Expressao:= ""
do case
case oBmp:aControls[ n ]:ClassName() == "TGET"
scaninfo->tipo := "GET"
case oBmp:aControls[ n ]:ClassName() == "TSAY"
scaninfo->tipo := "SAY"
case oBmp:aControls[ n ]:ClassName() == "TCHECKBOX"
scaninfo->tipo := "CHK"
endcase
scaninfo->largura := oBmp:aControls[ n ]:nWidth
scaninfo->altura := oBmp:aControls[ n ]:nHeight
dbRUnlock()
dbCommit()
next
dbSelectArea( "scanned" )
MsgBeep()
return nil
function LoadData( oBmp )
local n
local lTest := .t.
local cText := Space( 40 )
local oCtl
cModName = cGetFile( "*.bmp", "Selecione o formulario" )
oBmp:LoadBmp( cModName )
oGFWnd:SetText( "Form - " + AllTrim( cModName ) )
for n = 1 to Len( oBmp:aControls )
oBmp:aControls[ n ]:End()
SysRefresh()
next
dbSelectArea( "scaninfo" )
set filter to upper(scaninfo->nome) = upper(cFileName(cModName))
go top
do while ! Eof()
do case
case scaninfo->Tipo == "SAY"
@ scaninfo->linha, scaninfo->Coluna ;
SAY oCtl PROMPT scaninfo->Expressao ;
SIZE scaninfo->largura, scaninfo->altura ;
PIXEL OF oBmp COLOR "N/W+" DESIGN
case scaninfo->Tipo == "GET"
@ scaninfo->linha, scaninfo->Coluna ;
GET oCtl VAR cText OF oBmp COLOR "N/W" ;
SIZE scaninfo->largura, scaninfo->altura DESIGN PIXEL
case scaninfo->Tipo == "CHK"
@ scaninfo->linha, scaninfo->Coluna ;
CHECKBOX oCtl VAR lTest ;
SIZE scaninfo->largura - 1, scaninfo->altura - 1 ;
PIXEL OF oBmp COLOR "N/W" DESIGN
endcase
oCtl:bGotFocus = { || oCtl := oBmp:aControls[ AScan( oBmp:aControls, { | o | o:lFocused } ) ], oCtl:SetColor( "N/GR*" ) }
oCtl:bLostFocus = { || oCtl:SetColor( "N/W+" ) }
SKIP
enddo
dbSelectArea( "scanned" )
MsgBeep()
return nil
function imprimirbmp(Bmp,oBmp)
local oPrn
local nZoom := 4 // oBmp:Zoom()
local anchura := oBmp:nWidth() * nZoom
local altura := oBmp:nHeight()* nZoom
PRINT oPrn NAME "BITMAP" PREVIEW
PAGE
oPrn:SayBitmap(0,0,bmp,anchura,altura)
ENDPAGE
ENDPRINT
return nil
/*
* ******* ******* ******* *******
* Modulo de criacao de formularios
* ******* ******* ******* *******
*/
function desenha()
local oDlg
DEFINE DIALOG oDlg TITLE "Design Test"
ACTIVATE DIALOG oDlg CENTERED ;
ON INIT PlaceControl( oDlg ) ;
ON PAINT DrawGrid( oDlg:hWnd, hDC, cPS, 8, 8 )
return nil
function PlaceControl( oDlg )
@ 2, 3 BUTTON "Test" SIZE 80, 25 DESIGN OF oDlg
@ 5, 3 BUTTON "Another" SIZE 80, 25 DESIGN OF oDlg
return nil
static FUNCTION VerifyINI( _section_, _entry_, _var_, _inifile_, _grava_ )
oIni := TIni():New( _inifile_ )
if _grava_ = .t.
oIni:Set( _section_, _entry_, _var_ )
endif
return oIni:Get( _section_, _entry_, _var_, _var_ )
FUNCTION FEncripta( _oque_ )
return iif(lEncripta, "5VZ" + Codifica( alltrim( _oque_ ) ), _oque_ )
FUNCTION FDecripta( _oque_ )
return iif(lEncripta, iif( "5VZ" $ _oque_, Decodifica( StrTran( _oque_, "5VZ", "" ) ), _oque_ ), _oque_ )
FUNCTION codifica( _pass_ )
_senha_ := ''
for i = 1 to len(alltrim(_pass_))
_senha_ := _senha_ + chr(asc(substr(_pass_,i,1))+9)
next
return _senha_
FUNCTION decodifica( _pass_ )
_senha_ := ''
for i = 1 to len(alltrim(_pass_))
_senha_ := _senha_ + chr(asc(substr(_pass_,i,1))-9)
next
return _senha_
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para [url=mailto://fivolution@hotmail.com]fivolution@hotmail.com[/url]. Agradecido.
@braços : ? )
A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
@braços : ? )
A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
-
Kapiaba
- Colaborador
- Mensagens: 1908
- Registrado em: 07 Dez 2012 16:14
- Localização: São Paulo
- Contato:
DBU - Simulando dentro de sua aplicação Fivewin.
Bom dia Rochinha, achei muito interessante, poderia por favor postar o link novamente?
Feliz natal e próspero ano novo.
Obg. Abs.
Feliz natal e próspero ano novo.
Obg. Abs.
-
rochinha
- Administrador
- Mensagens: 4664
- Registrado em: 18 Ago 2003 20:43
- Localização: São Paulo - Brasil
- Contato:
DBU - Simulando dentro de sua aplicação Fivewin.
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para [url=mailto://fivolution@hotmail.com]fivolution@hotmail.com[/url]. Agradecido.
@braços : ? )
A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
@braços : ? )
A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
-
Euclides
- Usuário Nível 3
- Mensagens: 154
- Registrado em: 12 Mai 2007 14:07
- Localização: São Paulo, Capital
DBU - Simulando dentro de sua aplicação Fivewin.
Olá Rochinha! (Boas Festas atrasadas)
Interessante este Browse. Algumas considerações...
1 - Poderia retirar os "d:/develop/fivewin/fwh27/bitmaps/16x16" de BROWSE.RC que isso atrapalha em algo os "menos afortunados"...
2 - Poderia também acrescentar o PREV32.RC, os bitmaps e o LIB do TWBROWSE o amiguinho Hernán Diego Ceccarelli (acho que é assim) ao BrowserSuperUtil.zip
3 - Parabéns pelo trabalho!
[]´s Euclides
Interessante este Browse. Algumas considerações...
1 - Poderia retirar os "d:/develop/fivewin/fwh27/bitmaps/16x16" de BROWSE.RC que isso atrapalha em algo os "menos afortunados"...
2 - Poderia também acrescentar o PREV32.RC, os bitmaps e o LIB do TWBROWSE o amiguinho Hernán Diego Ceccarelli (acho que é assim) ao BrowserSuperUtil.zip
3 - Parabéns pelo trabalho!
[]´s Euclides
-
rochinha
- Administrador
- Mensagens: 4664
- Registrado em: 18 Ago 2003 20:43
- Localização: São Paulo - Brasil
- Contato:
DBU - Simulando dentro de sua aplicação Fivewin.
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para [url=mailto://fivolution@hotmail.com]fivolution@hotmail.com[/url]. Agradecido.
@braços : ? )
A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
@braços : ? )
A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.