Clipper On Line • Ver Tópico - DBU - Simulando dentro de sua aplicação Fivewin.

DBU - Simulando dentro de sua aplicação Fivewin.

Discussão sobre a biblioteca Fivewin - O Clipper para Windows.

Moderador: Moderadores

 

DBU - Simulando dentro de sua aplicação Fivewin.

Mensagempor rochinha » 02 Fev 2012 19:15

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
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

DBU - Simulando dentro de sua aplicação Fivewin.

Mensagempor rochinha » 02 Fev 2012 20:42

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
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

DBU - Simulando dentro de sua aplicação Fivewin.

Mensagempor rochinha » 02 Fev 2012 22:34

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.
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

DBU - Simulando dentro de sua aplicação Fivewin.

Mensagempor rochinha » 02 Fev 2012 22:35

Amiguinhos,

Codigo completo(parte 2)
/*
* ******* ******* ******* ******* *
* 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 fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

DBU - Simulando dentro de sua aplicação Fivewin.

Mensagempor Kapiaba » 20 Dez 2013 10:02

Bom dia Rochinha, achei muito interessante, poderia por favor postar o link novamente?

Feliz natal e próspero ano novo.

Obg. Abs.
Kapiaba
Colaborador

Colaborador
 
Mensagens: 1765
Data de registro: 07 Dez 2012 15:14
Cidade/Estado: São Paulo
Curtiu: 310 vezes
Mens.Curtidas: 119 vezes

DBU - Simulando dentro de sua aplicação Fivewin.

Mensagempor rochinha » 07 Jan 2014 12:56

Amiguinhos,

Segue link com codigo atualizado do BrowserSuperUtil.

Download
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

DBU - Simulando dentro de sua aplicação Fivewin.

Mensagempor Kapiaba » 09 Jan 2014 10:07

Obrigado Rochinha, muito bom mesmo.

Obg. Abs.
Kapiaba
Colaborador

Colaborador
 
Mensagens: 1765
Data de registro: 07 Dez 2012 15:14
Cidade/Estado: São Paulo
Curtiu: 310 vezes
Mens.Curtidas: 119 vezes

DBU - Simulando dentro de sua aplicação Fivewin.

Mensagempor Euclides » 10 Jan 2014 13:18

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
Euclides
Usuário Nível 3

Usuário Nível 3
 
Mensagens: 154
Data de registro: 12 Mai 2007 14:07
Cidade/Estado: São Paulo, Capital
Curtiu: 1 vez
Mens.Curtidas: 14 vezes

DBU - Simulando dentro de sua aplicação Fivewin.

Mensagempor rochinha » 14 Jan 2014 01:37

Amiguinhos,

Link de Download
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes




Retornar para FiveWin

Quem está online

Usuários vendo este fórum: Nenhum usuário registrado online e 6 visitantes


Ola Amigo, espero que meu site e forum tem lhe beneficiado, com exemplos e dicas de programacao.
Entao divulgue o link da Doacao abaixo para seus amigos e redes sociais ou faça uma doacao para o site forum...
MUITO OBRIGADO PELA SUA DOACAO!
Faça uma doação para o forum
cron
v
Olá visitante, seja bem-vindo ao Fórum Clipper On Line!
Efetue o seu login ou faça o seu Registro