Jump to content
Fivewin Brasil

letodbf fak


syspel

Recommended Posts

Dei uma identada, mas mesmo assim, em relação ao FIVEWIN the best, isso é uma coisa HORROROSA... KKKKKKKKKKKKKKKKKKK
hwgui??? Nem a PAU Juvenal. I LOVE FIVEWIN the best.

Leonardo, ça pohha num conecta. O que falta?  Abs. Desculpe a zueira, mas quem usa Five num vai nisso. Que bósnia.

/*
EMPRESA......: SYGECOM INFORMÁTICA LTDA
SISTEMA .....: AGENDA DE CONTATOS
DATA CRIAÇÃO.: 24/03/2008
TIPO DE BANCO: DBF - LOCAL ou REMOTO
PLATAFORMA...: WINDOWS
RESPONSAVEL..: LEONARDO MACHADO
*/
	#define x_BLUE       16711680
#define x_DARKBLUE   10027008
#define x_WHITE      16777215
#define x_CYAN       16776960
#define x_BLACK             0
#define x_RED             255
#define x_GREEN         32768
#define x_GRAY        8421504
#define x_YELLOW        65535
	#include "guilib.ch"
#include "inkey.ch"
#include "windows.ch"
#include "hwgui.ch"
	#define CORPADRAO  COLOR_3DLIGHT+3
#define BLUE 16711680
	FUNCTION Main()
	   PRIVATE oJanela
   PRIVATE oFont1, grpConfiguracao, o_Obtn1, btnPeso
   PRIVATE oIcon := HIcon():AddResource( "ICON_1" ), ;
      oBmp1 := HBitmap():AddFile( "res\novo.bmp" ), ;
      oBmp2 := HBitmap():AddFile( "res\sobre.bmp" ), ;
      oBmp3 := HBitmap():AddFile( "res\excluir.bmp" ), ;
      oBmp4 := HBitmap():AddFile( "res\calc.bmp" ), ;
      oBmp5 := HBitmap():AddFile( "res\calendario.bmp" ), ;
      oBmp6 := HBitmap():AddFile( "res\imp.bmp" ), ;
      oBmp7 := HBitmap():AddFile( "res\atualizar.bmp" ), ;
      oBmp8 := HBitmap():AddFile( "res\sair.bmp" )
	   PRIVATE lNovo := .F.
   PRIVATE GIndice
   PRIVATE oBrowse
	   PUBLIC vTipo_RDD := "DBFCDX"  // DBFCDX ou LETO
	   Local_Remoto()  // opção se vai usar DBF local ou remoto
	   IF vTipo_RDD = "LETO"
      IF Inetestaconectada() = .F.
         MsgStop( "Não foi possível estabelecer uma conexão com a Intenet, Favor verificar.", "Aviso do Sistema" )
         RETURN .F.
      ENDIF
	      PUBLIC cServer := "//192.168.254.16"
      PUBLIC cPorta  := ":2812/"
      PUBLIC cPath   := cServer + cPorta + "dados/"
	      REQUEST LETO
      RDDSETDEFAULT( "LETO" )
	      PRIVATE oDlgHabla := NIL
      MsgRun( "Aguarde conectando ao Servidor..." )
      Leto_Disconnect()
	      IF ( leto_Connect( cServer + cPorta ) ) == - 1
         MsgInfo( "Não foi possivel conectar ao Servidor", "Aviso do Sistema" )
         FiM_Run()
         RETURN .F.
      ENDIF
      FiM_Run()
   ELSE
      Makedir( "dados" )  // criando a pasta dados
	      PUBLIC cPath   := "dados\"
	      REQUEST DBFCDX
      RDDSETDEFAULT( "DBFCDX" )
      DBSETDRIVER( "DBFCDX" )
   ENDIF
	   REQUEST HB_LANG_PT
   REQUEST HB_CODEPAGE_PT850
	   HB_LANGSELECT( "PT" )
   HB_SETCODEPAGE( "PT850" )
	   SET EXCLUSIVE OFF
   SET CONFIRM OFF
   SET DELE ON
   SET EPOCH TO 2000
   SetKey( K_ALT_C, {|| Finaliza_Sistema() } )
   SetKey( K_F9   , {|| ShellExecute( "calc" ) } )
	   IF ( hWnd := Hwg_FindWindow( oJanela,"Sistema de Agenda de Contatos - Sygecom Informática Ltda" ) ) != 0
      Hwg_SetForegroundWindow( hWnd )
      RETURN
   ENDIF
	   SetToolTipBalloon( .T. )
   SetColorinFocus( .T. )
	   PREPARE FONT oFontBtn NAME "Arial" WIDTH 0 HEIGHT - 12 charset 255
   INIT DIALOG oJanela CLIPPER NOEXIT NOEXITESC TITLE "Sistema de Agenda de Contatos - Sygecom Informática Ltda";
      FONT oFontBtn;
      AT 0, 0 SIZE 500, 480;
      ICON oIcon ;
      STYLE DS_CENTER + WS_VISIBLE + WS_CAPTION + WS_SYSMENU
	   @ 10, 460 SAY "Web Site: http://www.sygecom.com.br";
      LINK "http://www.sygecom.com.br" ;
      SIZE 210, 22
	   AgendaOpen()
	   SELE LETRA
   @ 415, 010 BROWSE GIndice DATABASE Of oJanela SIZE 50, 360;
      STYLE  WS_VSCROLL + WS_HSCROLL;
      ON CLICK {|| Pega_letra() }
	   GIndice:AddColumn( HColumn():New( "L",    FieldBlock(Fieldname(1 ) ),"C",1,0,,,,,,,,,{|| Cancela_filtro(),DbGoTop(),oBrowse:Refresh() } ) )
   GIndice:bcolorSel := VColor( "800080" )
   GIndice:ofont := HFont():Add( 'Arial', 0, - 9 )
	   GIndice:aColumns[1]:nJusHead := DT_CENTER
   GIndice:aColumns[1]:nJusLin  := DT_CENTER
   GIndice:aColumns[1]:length := 3
	   SELE AGENDA
   @ 010, 010 BROWSE oBrowse DATABASE of oJanela SIZE  398, 360;
      STYLE  WS_VSCROLL + WS_HSCROLL;
      ON CLICK {||Novo_Registro( .F. ) };
      ON POSCHANGE {|| SetFocus( oBrowse:handle ) }
	   oBrowse:bKeyDown := {|o, key| BrowseKey1( o, key ) }
	   oBrowse:AddColumn( HColumn():New( "Codigo", FieldBlock(Fieldname(1 ) ),"N",6,0 ) )
   oBrowse:AddColumn( HColumn():New( "Nome",   FieldBlock(Fieldname(2 ) ),"C",40,0 ) )
	   oBrowse:bcolorSel := VColor( "800080" )
   oBrowse:ofont := HFont():Add( 'Arial', 0, - 12 )
	   oBrowse:aColumns[1]:nJusHead := DT_CENTER
   oBrowse:aColumns[1]:nJusLin  := DT_CENTER
	   oBrowse:Refresh()
	   vPosicao = 0
	   @ vPosicao + 10, 385  OWNERBUTTON Of oJanela      ;
      ON CLICK {|| Novo_Registro( .T. ) }  ;
      SIZE 50, 50;
      TOOLTIP "Clique Aqui Para Cadastrar um Novo Registro"    ;
      BITMAP oBmp1 FROM RESOURCE TRANSPARENT;
      FLAT
   vPosicao = vPosicao + 60
	   @ vPosicao, 385  OWNERBUTTON Of oJanela      ;
      ON CLICK {|| Deleta_reg() } ;
      SIZE 50, 50;
      TOOLTIP "Clique Aqui para Deletar o Registro de Contato"    ;
      BITMAP oBmp3 FROM RESOURCE TRANSPARENT;
      FLAT
   vPosicao = vPosicao + 60
	   @ vPosicao, 385  OWNERBUTTON Of oJanela      ;
      ON CLICK {|| Imp_Contato() } ;
      SIZE 50, 50;
      TOOLTIP "Clique Aqui para Imprimir os dados do Contato";
      BITMAP oBmp6 FROM RESOURCE TRANSPARENT;
      FLAT
   vPosicao = vPosicao + 60
	   @ vPosicao, 385  OWNERBUTTON Of oJanela;
      ON CLICK {|| Sobre() } ;
      SIZE 50, 50;
      TOOLTIP "Sobre a Sygecom Informática Ltda";
      BITMAP oBmp2 FROM RESOURCE TRANSPARENT;
      FLAT
   vPosicao = vPosicao + 60
	   @ vPosicao, 385  OWNERBUTTON Of oJanela;
      ON CLICK {|| Set_Calc() } ;
      SIZE 50, 50;
      TOOLTIP "Clique Aqui para chamar a Calculadora";
      BITMAP oBmp4 FROM RESOURCE TRANSPARENT;
      FLAT
   vPosicao = vPosicao + 60
	   @ vPosicao, 385  OWNERBUTTON Of oJanela;
      ON CLICK {|| RunApplet( "timedate.cpl" ) } ;
      SIZE 50, 50;
      TOOLTIP "Clique Aqui para ver o Calendario";
      BITMAP oBmp5 FROM RESOURCE TRANSPARENT;
      FLAT
   vPosicao = vPosicao + 60
	   @ vPosicao, 385  OWNERBUTTON Of oJanela;
      ON CLICK {|| MsgInfo( "Em Desenvolvimento..." ) } ;
      SIZE 50, 50;
      TOOLTIP "Clique Aqui para ver Atualizar o sistema";
      BITMAP oBmp7 FROM RESOURCE TRANSPARENT;
      FLAT
   vPosicao = vPosicao + 60
	   @ vPosicao, 385  OWNERBUTTON Of oJanela      ;
      ON CLICK {|| Finaliza_Sistema( 1 ) }           ;
      SIZE 50, 50;
      TOOLTIP "Sair do Sistema"    ;
      BITMAP oBmp8 FROM RESOURCE TRANSPARENT;
      FLAT
	   ACTIVATE DIALOG oJanela
	   RETURN nil
	//******************
	FUNCTION Pega_Letra
	//******************
   cLetra := LETRA->L
   Pesquisa_Agenda( cLetra )
	   RETURN
	//*****************************
	FUNCTION Pesquisa_Agenda( cPesq )
	//*****************************
   IF cPesq == Nil
      cPesq := "A"
   ENDIF
   SELE AGENDA
   DBSETORDER( 3 )
   ORDScope( 0, cPesq )
   ORDScope( 1, cPesq )
   DBGOTOP()
   oBrowse:Refresh()
	   RETURN Nil
	//**********************
	FUNCTION Cancela_Filtro
	//**********************
   SELE AGENDA
   ORDScope( 0, Nil )
   ORDScope( 1, Nil )
   DBGOTOP()
   oBrowse:Refresh()
	   RETURN .T.
	//******************
	FUNCTION Deleta_reg
	//******************
   cReg := AGENDA->CODIGO
   cNome := AGENDA->NOME
   IF EMPTY( cNome )
      MsgInfo( "Não foi possivel Localizar o registro", "Aviso do Sistema" )
      RETURN Nil
   ENDIF
   IF MsgYesNo( "Confirma Exclusão do Codigo: " + str( cReg ) + " Nome: " + ALLTRIM( cNome ) + " ?", "Excluir Contato" )
      SELE AGENDA
      DBSETORDER( 1 )
      DBSEEK( cReg )
      IF Found()
         TRAVAREG()
         dbDELETE()
         DBCOMMIT()
         LIBERAREG()
      ENDIF
      Dbgotop()
      oBrowse:Refresh()
   ENDIF
	   RETURN
	//**********************************
	FUNCTION BrowseKey1( oBrowse, key )
	//**********************************
   DO CASE
   CASE KEY = VK_RETURN
      Novo_Registro( .F. )
   CASE KEY = 1
      EndDialog()
   CASE KEY = VK_F9
      ShellExecute( "calc" )
   OTHERWISE
      IF KEY = 46
         IF MsgYesNo( "Confirma Exclusão do Codigo ?", "Excluir Contato" )
            TRAVAREG()
            DELE
            DBCOMMIT()
            LIBERAREG()
            DBGOTOP()
            oBrowse:Refresh()
         ENDIF
      ENDIF
      IF KEY = 27
         Finaliza_Sistema()
      ENDIF
   ENDCASE
	   RETURN .T.
	//****************************************
	FUNCTION Novo_Registro( lNovo_Registro  )
	//****************************************
   LOCAL lExc := .F.
   LOCAL Botao_salvar, Botao_Cancelar, Botao_Deletar
	   PRIVATE oIcon := HIcon():AddResource( "ICON_1" )
   PRIVATE Form_2
   PRIVATE T_Codigo
   PRIVATE T_Nome
   PRIVATE T_Endereco
   PRIVATE T_Bairro
   PRIVATE T_Cep
   PRIVATE T_Cidade
   PRIVATE T_Estado
   PRIVATE T_Fone1
   PRIVATE T_Fone2
   PRIVATE T_Email
	   PRIVATE cCodigo   := 0
   PRIVATE cNome     := ""
   PRIVATE cEndereco := ""
   PRIVATE cBairro   := ""
   PRIVATE cCep      := ""
   PRIVATE cCidade   := ""
   PRIVATE cEstado   := ""
   PRIVATE cFone1    := ""
   PRIVATE cFone2    := ""
   PRIVATE cEmail    := ""
   PRIVATE aItens    := { "AC", "AL", "AP", "AM", "BA", "CE", "DF", "GO", "ES", "MA", "MT", "MS", "MG", "PA", "PB", "PR", "PE", "PI", "RJ", "RN", "RS", "RO", "RR", "SP", "SC", "SE", "TO" }
	   lNovo := lNovo_Registro
	   IF ! lNovo
      cCodigo := codigo
      SELE AGENDA
      DBGOTOP()
      DBSetOrder( 1 )
      DBSeek( cCodigo )
      IF !FOUND()
         MsgSTOP( "Registro " + STR( cCodigo ) + " Não localizado!!", "Agenda" )
         RETURN Nil
      ENDIF
      cNome     := AllTrim( Agenda->Nome )
      cEndereco := AllTrim( Agenda->Endereco )
      cBairro   := AllTrim( Agenda->Bairro )
      cCep      := AllTrim( Agenda->Cep )
      cCidade   := AllTrim( Agenda->Cidade )
      cEstado   := AllTrim( Agenda->Estado )
      cFone1    := AllTrim( Agenda->Fone1 )
      cFone2    := AllTrim( Agenda->Fone2 )
      cEmail    := AllTrim( Agenda->EMail )
   ELSE
      Agenda->( DBSetOrder( 1 ) )
      DbGoBottom()
      cCodigo := CODIGO + 1
   ENDIF
	   SetToolTipBalloon( .T. )
   SetColorinFocus( .T. )
	   PREPARE FONT oFonte NAME "Arial" WIDTH 0 HEIGHT - 12 charset 255
   INIT DIALOG Form_2   ;
      AT 0, 0                   ;
      SIZE 490, 300 ;
      ICON oIcon ;
      TITLE "Agenda de Contatos - " + Iif( lNovo , "Novo Registro" , "Alterando Registro" );
      CLIPPER NOEXIT;
      FONT oFonte
	   @ 10 , 10   SAY 'Código:'   COLOR BLUE SIZE 140, 30
   @ 10 , 40   SAY 'Nome:'     COLOR BLUE SIZE 140, 30
   @ 10 , 70   SAY 'Endereço:' COLOR BLUE SIZE 140, 30
   @ 10 , 100  SAY "Bairro:"   COLOR BLUE SIZE 140, 30
   @ 360, 100  SAY "Cep:"      COLOR BLUE SIZE 140, 30
   @ 10 , 130  SAY "Cidade:"   COLOR BLUE SIZE 140, 30
   @ 345, 130  SAY "Estado:"   COLOR BLUE SIZE 140, 30
   @ 10 , 160  SAY "TeleFone:" COLOR BLUE SIZE 140, 30
   @ 300, 160  SAY "Celular:"  COLOR BLUE SIZE 140, 30
   @ 10 , 190  SAY "E-Mail:"   COLOR BLUE SIZE 140, 30
	   @ 70 , 13  GET T_Codigo   VAR cCodigo   PICTURE "999999"                      SIZE 40 , 24;
      STYLE WS_DISABLED;
      TOOLTIP "Informe o Numero"
	   @ 70 , 43  GET T_Nome     VAR cNome     PICTURE "@!"                          SIZE 400, 24;
      MAXLENGTH 40;
      STYLE WS_TABSTOP;
      TOOLTIP "Informe o Nome do Contato"
	   @ 70 , 73  GET T_Endereco VAR cEndereco PICTURE Replicate( "X", 40 )             SIZE 400, 24;
      STYLE WS_TABSTOP;
      TOOLTIP "Informe o Endereço"
	   @ 70 , 103  GET T_Bairro   VAR cBairro   PICTURE Replicate( "X", 25 )             SIZE 250, 24;
      STYLE WS_TABSTOP;
      TOOLTIP "Informe o Bairro"
	   @ 390, 103  GET T_Cep      VAR cCep      PICTURE "@R 99999-999"                SIZE 80 , 24;
      STYLE WS_TABSTOP;
      TOOLTIP "Informe o Cep"
	   @ 70 , 133  GET T_Cidade   VAR cCidade   PICTURE Replicate( "X", 25 )             SIZE 250, 24;
      STYLE WS_TABSTOP;
      TOOLTIP "Informe a Cidade"
	   @ 390, 133  GET COMBOBOX T_Estado  VAR cEstado  ITEMS aItens                  SIZE 50, 24 TEXT;
      STYLE WS_TABSTOP;
      TOOLTIP "Informe o Estado"
	   @ 70 , 163  GET T_Fone1    VAR cFone1    PICTURE  "@R (99) 9999-9999"          SIZE 110, 24;
      STYLE WS_TABSTOP;
      TOOLTIP "Informe o Telefone Convencional"
	   @ 360, 163  GET T_Fone2    VAR cFone2    PICTURE  "@R (99) 9999-9999"          SIZE 110, 24;
      STYLE WS_TABSTOP;
      TOOLTIP "Informe o Telefone Celular"
	   @ 70 , 193  GET T_Email    VAR cEmail    PICTURE Replicate( "X", 60 )             SIZE 400, 24;
      STYLE WS_TABSTOP;
      TOOLTIP "Informe o Bairro"
	   @ 70, 232  BUTTON "&Salvar" SIZE 120, 35 ;
      TOOLTIP "Clique Aqui para Salvar";
      ON CLICK {||Salvar_Registro() }      ;
      STYLE WS_TABSTOP
	   @ 210, 232  BUTTON "&Sair" SIZE 120, 35 ;
      TOOLTIP "Clique Aqui para Sair";
      ON CLICK {|| EndDialog() };
      STYLE WS_TABSTOP
	   ACTIVATE DIALOG Form_2
	   RETURN Nil
	//*************************
	FUNCTION Salvar_Registro()
	//*************************
   IF Empty( cNome )
      MsgINFO( "Nome Não foi Informado !!" , "Agenda" )
      T_Nome:SetFocus()
      RETURN Nil
   ENDIF
   Form_2:Close()
	   IF lNovo
      SELE AGENDA
      DBGOTOP()
      DBSetOrder( 2 )
      DBSeek( cNome )
      IF FOUND()
         MsgSTOP( "Nome Já Cadastrado, Favor Vereficar !!", "Agenda" )
         RETURN Nil
      ENDIF
      Agenda->( DBAppend() )
      Agenda->Codigo   := cCodigo
      Agenda->Nome     := cNome
      Agenda->Endereco := cEndereco
      Agenda->Bairro   := cBairro
      Agenda->Cep      := cCep
      Agenda->Cidade   := cCidade
      Agenda->Estado   := cEstado
      Agenda->Fone1    := cFone1
      Agenda->Fone2    := cFone2
      Agenda->EMail    := cEmail
      lNovo := .F.
   ELSE
      SELE AGENDA
      cCodigo := cCodigo
      Agenda->( DBSetOrder( 1 ) )
      IF ! Agenda->( DBSeek( cCodigo  ) )
         MsgSTOP( "Registro " + STR( cCodigo ) + " não localizado!!", "Agenda" )
      ENDIF
      TRAVAREG()
      Agenda->Nome      := cNome
      Agenda->Endereco  := cEndereco
      Agenda->Bairro    := cBairro
      Agenda->Cep       := cCep
      Agenda->Cidade    := cCidade
      Agenda->Estado    := cEstado
      Agenda->Fone1     := cFone1
      Agenda->Fone2     := cFone2
      Agenda->EMail     := cEmail
      Agenda->( DBUnlock() )
      LIBERAREG()
   ENDIF
	   DBGOTOP()
   oBrowse:Refresh()
	   RETURN Nil
	//********************
	FUNCTION AgendaOpen()
	//********************
   LOCAL i, abcd := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   PRIVATE oDlgHabla := NIL
	   MsgRun( "Aguarde Verificando Tabelas..." )
   IF vTipo_RDD = "LETO"
      IF LETO_FILE( "AGENDA.DBF" ) = .T.
         HW_Atualiza_Dialogo( "Criando Tabela Agenda..." )
         aArq := {}
         Aadd( aArq , { 'CODIGO'   , 'N' , 06 , 0 } )
         Aadd( aArq , { 'NOME '    , 'C' , 40 , 0 } )
         Aadd( aArq , { 'ENDERECO' , 'C' , 40 , 0 } )
         Aadd( aArq , { 'BAIRRO'   , 'C' , 25 , 0 } )
         Aadd( aArq , { 'CEP'      , 'C' , 08 , 0 } )
         Aadd( aArq , { 'CIDADE'   , 'C' , 25 , 0 } )
         Aadd( aArq , { 'ESTADO'   , 'C' , 02 , 0 } )
         Aadd( aArq , { 'FONE1'    , 'C' , 10 , 0 } )
         Aadd( aArq , { 'FONE2'    , 'C' , 10 , 0 } )
         Aadd( aArq , { 'EMAIL'    , 'C' , 60 , 0 } )
         DBCreate( cPath + "AGENDA.DBF" , aArq )
      ENDIF
      IF LETO_FILE( "LETRA.DBF" ) = .T.
         HW_Atualiza_Dialogo( "Criando Tabela Letra..." )
         aArq := {}
         Aadd( aArq , { 'L'   , 'C' , 01 , 0 } )
         DBCreate( cPath + "LETRA.DBF" , aArq )
	         SELE 1
         USE ( cPath + "LETRA" ) ALIAS TEMP NEW shared
         SELE TEMP
	         IF vTipo_RDD = "LETO"
            leto_BeginTransaction()
         ENDIF
	         HW_Atualiza_Dialogo( "Preenchendo Tabela Letra..." )
         FOR i := 1 TO Len( abcd )
            AppRede()
            REPL L  WITH Substr( abcd, i, 1 )
         NEXT
         DBCOMMIT()
	         IF vTipo_RDD = "LETO"
            leto_CommitTransaction()
         ENDIF
	         SELE TEMP
         USE
      ENDIF
	      IF LETO_FILE( "AGENDA1.CDX" ) = .T.
         HW_Atualiza_Dialogo( "Criando Indice Agenda..." )
         SELE 2
         USE ( cPath + "AGENDA" ) ALIAS TEMP2 NEW shared
         INDEX ON Codigo           TAG 1
         INDEX ON Nome             TAG 2
         INDEX ON Substr( Nome, 1, 1 ) TAG 3
         SELE TEMP2
         USE
      ENDIF
   ELSE
      IF ! FILE( cPath + "AGENDA.DBF" )
         HW_Atualiza_Dialogo( "Criando Tabela Agenda..." )
         aArq := {}
         Aadd( aArq , { 'CODIGO'   , 'N' , 06 , 0 } )
         Aadd( aArq , { 'NOME '    , 'C' , 40 , 0 } )
         Aadd( aArq , { 'ENDERECO' , 'C' , 40 , 0 } )
         Aadd( aArq , { 'BAIRRO'   , 'C' , 25 , 0 } )
         Aadd( aArq , { 'CEP'      , 'C' , 08 , 0 } )
         Aadd( aArq , { 'CIDADE'   , 'C' , 25 , 0 } )
         Aadd( aArq , { 'ESTADO'   , 'C' , 02 , 0 } )
         Aadd( aArq , { 'FONE1'    , 'C' , 10 , 0 } )
         Aadd( aArq , { 'FONE2'    , 'C' , 10 , 0 } )
         Aadd( aArq , { 'EMAIL'    , 'C' , 60 , 0 } )
         DBCreate( cPath + "AGENDA.DBF" , aArq )
      ENDIF
	      IF ! FILE( cPath + "LETRA.DBF" )
         HW_Atualiza_Dialogo( "Criando Tabela Letra..." )
         aArq := {}
         Aadd( aArq , { 'L'   , 'C' , 01 , 0 } )
         DBCreate( cPath + "LETRA.DBF" , aArq )
	         SELE 1
         USE ( cPath + "LETRA" ) ALIAS TEMP NEW shared
         SELE TEMP
	         HW_Atualiza_Dialogo( "Preenchendo Tabela Letra..." )
         FOR i := 1 TO Len( abcd )
            AppRede()
            REPL L  WITH Substr( abcd, i, 1 )
         NEXT
         LIBERAREG()
         DBCOMMIT()
	         SELE TEMP
         USE
      ENDIF
	      IF ! File( cPath + "AGENDA1.CDX" )
         HW_Atualiza_Dialogo( "Criando Indice Agenda..." )
         SELE 2
         USE ( cPath + "AGENDA" ) ALIAS TEMP2 NEW shared
         INDEX ON Codigo           TAG 1
         INDEX ON Nome             TAG 2
         INDEX ON Substr( Nome, 1, 1 ) TAG 3
         SELE TEMP2
         USE
      ENDIF
   ENDIF
	   HW_Atualiza_Dialogo( "Abrindo Tabelas e Indices..." )
	   SELE 1
   USE ( cPath + "AGENDA" ) ALIAS Agenda SHARED
	   SELE 2
   USE ( cPath + "LETRA" ) ALIAS LETRA SHARED
   Fim_Run()
	   RETURN Nil
	//*******************************************************************************
//**************INICIO DA MENSAGEM RUM NA TELA***********************************
//*******************************************************************************
//delclara a variavel do dialogo
//Private oDlgHabla:=nil
	//Mostra a tela de dialogo
//MsgRun()
	//inicia a impressão a cada linha
//HW_Atualiza_Dialogo(vMENSAGEM)
	//fin do relatorio
//hw_FimDialogoTemporal()
	// -----------------------------------
// Rutina para un diálogo temporizado.
// -----------------------------------
	FUNCTION Inicia_Run()
	   PRIVATE oDlgHabla := nil
	FUNCTION MsgRun( cMsg, cTime )
	   LOCAL vModal, vMsg := [Aguarde em processamento....], vMsg2 := []
   LOCAL oFonte := oFonte := HFont():Add( "Arial"     , 0 , - 15, 500, 255 )
   PRIVATE oTimHabla
	   IF cMsg # nil
      vMsg := cMsg
   ENDIF
	   INIT DIALOG oDlgHabla ;
      SIZE 485, 80  ;
      STYLE DS_CENTER + WS_VISIBLE ;
      ON INIT { || IniDlgHabla( cTime ) } ;
      ON EXIT { || Hw_FimDialogoTemporal( cTime ) }
	   @ 0, 20  SAY vMsg SIZE 465, 20 STYLE SS_CENTER FONT oFonte
	   IF ctime = nil
      vModal := .T.
   ENDIF
   oDlgHabla:Activate( vModal )
	   RETURN .T.
	// ----------------------
// Inicializar el diálogo
// ----------------------
	STATIC FUNCTION IniDlgHabla( cTime )
	   oDlgHabla:Center()
   IF cTime # nil
      SET TIMER oTimHabla OF oDlgHabla ID 9006 VALUE cTime ACTION {|| CierraDialogo() }
   ENDIF
	   RETURN .T.
	// ---------------
// Fin del diálogo
// ---------------
	FUNCTION Hw_FimDialogoTemporal( cTime )
	   IF cTime # nil
      IF oDlgHabla # nil
         oDlgHabla:close()
         oDlgHabla := nil
      ENDIF
   ENDIF
	   RETURN .T.
	FUNCTION Fim_Run()
	   IF oDlgHabla # NIL
      oDlgHabla:CLOSE()
   ENDIF
	// ---------------
// Cerrar diálogo.
// ---------------
	FUNCTION CierraDialogo()
	   EndDialog()
	   RETURN .T.
	FUNCTION HW_Atualiza_Dialogo( vMensagem )
	   GTprocessmessages()
   oDlgHabla:ACONTROLS[1]:SETTEXT( vMensagem )
	   RETURN NIL
	//*******************************************************************************
//**************FIM DA MENSAGEM RUM NA TELA**************************************
//*******************************************************************************
	FUNCTION logo_sygecom
	   LOCAL oSplash
	   IF file( "res\sygecom.bmp" )
      SPLASH oSplash TO "res\sygecom.bmp" TIME 500
   ENDIF
	   RETURN NIL
	//*******************************************************************************
//**************INICIO DO TESTE DE CONEXÃO DE INTERNET***************************
//*******************************************************************************
	//*************************************
	FUNCTION inetestaconectada( cAddress )
	//*************************************
   LOCAL aHosts
   LOCAL cName
   InetInit()
   IF cAddress == NIL
      cAddress := "www.google.com.br"
   ENDIF
   aHosts := InetGetHosts( cAddress )
   IF aHosts == NIL .OR. len( aHosts ) = 0
      InetCleanup()
      RETURN .F.
   ENDIF
   InetCleanup()
	   RETURN .T.
	//*******************************************************************************
//**************FIM DO TESTE DE CONEXÃO DE INTERNET******************************
//*******************************************************************************
	//************************
	FUNCTION Finaliza_Sistema
	//************************
   IF MsgYesNo( "Confirma saída do sistema?" )
      DBCLOSEALL()
      IF vTipo_RDD = "LETO"
         leto_Disconnect()
      ENDIF
      Logo_sygecom()
      QUIT
   ENDIF
	   RETURN .T.
	//*************
	FUNC LiberaREG
	//*************
   DBUNLOCK()
	   RETURN
	//************
	FUNC AppRede()
	//************
   PRIVATE oDlgHabla := NIL
   WHILE .T.
      DbAppend()
      IF !NetErr()
         RETURN( .T. )
      ELSE
         MilliSec( 1000 )
         LOOP
      ENDIF
   ENDDO
	   RETURN( Nil )
	//*****************
	FUNCTION TravaReg
	//*****************
   WHILE .T.
      WHILE .T. // Eternamente
         IF Rlock()
            RETURN( .T. )
         ELSE // TENTA DE NOVO
            MilliSec( 1000 )
            LOOP
         ENDIF
      ENDDO
      MsgINFO( "Não foi possível Travar o registro, Tente mais tarde.", "Aviso do Sistema" )
      RETURN( .F. )
      EXIT
   ENDDO
	   RETURN Nil
	//*************
	FUNCTION Sobre
	//*************
   LOCAL FormSobre
   LOCAL Fonte   := HFont():Add( "Arial", 0, - 13 )
   PRIVATE oIcon := HIcon():AddResource( "ICON_1" ), ;
      oBmpLogo1 := HBitmap():AddFile( "res\sygecom2.bmp" )
	   INIT DIALOG FormSobre TITLE "Informações da Sygecom Informática Ltda" ;
      AT 110, 100  SIZE 700, 320 ;
      ICON oIcon ;
      FONT Fonte ;
      STYLE WS_DLGFRAME + WS_SYSMENU + DS_CENTER
	   @ 510, 5 OWNERBUTTON o_Obtn1;
      SIZE 190, 185 ;
      FLAT;
      BITMAP oBmpLogo1 FROM RESOURCE TRANSPARENT;
      TOOLTIP "Sygecom Informatica Ltda"
	   @ 20, 10  SAY "Sygecom Informática Ltda - O Selo do Software    " SIZE 500, 22
   @ 20, 40  SAY "Av. Artur Garcia, 271      Cep:94810-090         " SIZE 500, 22
   @ 20, 70  SAY "Alvorada - RS                                    " SIZE 500, 22
   @ 20, 100 SAY "Fone:51-3442-2345 / 51-3442-3975 / 51-9191-3474  " SIZE 500, 22
   @ 20, 130 SAY "Web Site: http://www.sygecom.com.br";
      LINK "http://www.sygecom.com.br" ;
      SIZE 230, 22
   @ 20, 160 SAY "E-mail-Msn:suporte@sygecom.com.br            "     SIZE 500, 22
   @ 20, 185 SAY "Programador Responsavel.: Leonardo Machado   "     SIZE 500, 22
   @ 20, 210 SAY "Versão Compilador.:" + version() + " + " + HWG_Version() SIZE 500, 22
	   @ 280, 240 BUTTON "Sair" SIZE 100, 32 ;
      ON CLICK {|| EndDialog() };
      STYLE WS_TABSTOP
	   ACTIVATE DIALOG FormSobre
	   RETURN Nil
	//************************************
	FUNCTION Set_Calc()   //Calculadora()
	//************************************
   LOCAL hWnd
   IF ( hWnd := SeekCalculadora() ) == 0
      WinExec( 'Calc.Exe', SW_NORMAL )
   ELSE
      BringWindowToTop( hWnd )
      ShowWindow( hWnd, SW_RESTORE )
   ENDIF
	   RETURN Nil
	//********************************
	STATIC FUNCTION SeekCalculadora()
	//********************************
   LOCAL aCaptions := { 'Calc', 'Calculator', 'Calculadora' }
   LOCAL nPos, hWnd
   FOR nPos = 1 TO Len( aCaptions )
      IF ( hWnd := FindWindow( 0, aCaptions[nPos] ) ) > 0
         RETURN hWnd
      ENDIF
   NEXT
	   RETURN hWnd
	FUNCTION RunApplet( cApplet )
	   ShellExecute( "rundll32.exe", "open", "shell32.dll, Control_RunDLL " + cApplet, "5" )
	   RETURN Nil
	//****************
	FUNCTION CHAMAIMP
	//****************
   LOCAL cPrinterName, cPrinterPort
   LOCAL aPrn    := GetPrinters()
   PARA TAM, cARQ      // S=136 N=79
	   IF TAM = Nil
      TAM = "S"
   ENDIF
	   IF Empty( aPrn )
      IF MsgYesNo( "ATENÇÃO !!! Não foi possivel localizar Nenhuma impressora Instalada no Windows, Deseja Instalar uma Agora ?", "Aviso do Sistema" )
         RunApplet_imp( "AddPrinter" )
      ENDIF
      RETURN
   ENDIF
	   IF !EMPTY( cARQ )
      cFILE := cARQ
   ELSE
      MsgInfo( "Não foi possivel Gerar arquivo de impressão", "Aviso do Sistema" )
      RETURN
   ENDIF
	   nPrn := PrintSetup( @cPrinterName )
	   IF TAM = "S"
      IF !EMPTY( nPrn )
         Imprime( cFILE, 136, cPrinterName )
      ENDIF
   ELSE
      IF !EMPTY( nPrn )
         Imprime( cFILE, 80, cPrinterName )
      ENDIF
   ENDIF
	   RETURN NIL
	FUNCTION RunApplet_imp( cApplet ) //CONFIGURA IMPRESSORA NO WINDOWS
	   ShellExecute( "rundll32.exe", "open", "shell32.dll, SHHelpShortcuts_RunDLL " + cApplet, "2" )
	   RETURN Nil
	//*****************************************
	FUNCTION Imprime( cArq, tamrel , cPrinter )
	//*****************************************
   LOCAL cTexto, nLinhas, nA, cLinha
   LOCAL oPrinter := win32prn():New( cPrinter )
	   oPrinter:Landscape := .F.
   oPrinter:FormType  := 9
   oprinter:SetPrintQuality( - 1 ) // qualidade da impressão
	   oPrinter:Copies    := 1
	   GERAFILE()
   vARQ := {}
   aadd( vARQ, { "LINHA", "C", 200, 0 } )
   DBcreate( cFILE, vARQ, "DBFCDX" )
	   SELE 40
   USE ( cFILE ) ALIAS TEMPIMP EXCL VIA "DBFCDX"
   APPEND from ( cArq ) sdf // nome completo do arquivo sdf
	   oPrinter:Create()
   IF !oPrinter:Create()
      MsgStop( "ATENÇÃO !!! Não foi possivel Iniciar a Impressão, Favor Verificar se a Impressora esta Ligada.", "Aviso do Sistema" )
      RETURN NIL
   ELSE
      IF !oPrinter:StartDoc( "Impressao de Contato" )
         MsgStop( "ATENÇÃO !!! Não foi possivel Iniciar a Impressão, Favor Verificar o Spoll da Impressora", "Aviso do Sistema" )
         RETURN NIL
      ENDIF
	      IF FILE( "res\logo.bmp" )  // se tiver o arquivo logo.bmp dentro da mesma pasta ele vai imprimir o logo primeiro
         PrintBitMap( oPrinter )
         aTamlog := 9
      ELSE
         aTamlog := 0
      ENDIF
	      FOR TT = 1 TO aTamlog
         oPrinter:newline()
      NEXT
	      IF TAMREL = 80
         oPrinter:setfont( 'Courier New', , 11, , , , 255 ) // Normal
      ELSE
         oPrinter:SetFont( "Courier New", 11, { 3, - 50 } ) // Comprimida
      ENDIF
      oPrinter:Bold( 0 ) // Normal
	      dbgotop()
      DO WHILE !eof()
         cLinha := Linha    // Busca linha de impressao
         oPrinter:newline() // Inicia nova linha
	         oPrinter:SetFont( "Courier New", 11, { 3, - 50 } ) // Comprimida
	         oPrinter:TextOut( HB_OemToAnsi( cLinha ) )
         oPrinter:Bold( 0 ) // Normal
         dbskip()
	         IF !eof()
            IF ( oPrinter:MaxRow() - 2 ) <= oPrinter:Prow() // Usa "oPrinter:NewPage()" para iniciar nova pagina
               oPrinter:NewPage()
               IF FILE( "res\logo.bmp" )  // se tiver o arquivo logo.bmp dentro da mesma pasta ele vai imprimir o logo primeiro
                  PrintBitMap( oPrinter )
                  aTamlog := 9
               ELSE
                  aTamlog := 0
               ENDIF
	               FOR TT = 1 TO aTamlog
                  oPrinter:newline()
               NEXT
            ENDIF
         ENDIF
      ENDDO
      oPrinter:EndDoc()
      oPrinter:Destroy()
   ENDIF
   SELE TEMPIMP
   USE
	   RETURN NIL
	//**************************
	FUNCTION PrintBitMap( oPrn )  //função para imprimir imagem do logotipo
	//**************************
   LOCAL oBMP
   oBMP := Win32BMP():new()
   oBmp:loadFile( "res\logo.bmp" )
   oBmp:Draw( oPrn,  { 200, 200, 500, 500 } )
   oBMP:Destroy()
	   RETURN
	//********************
	FUNCTION Local_Remoto
	//********************
   LOCAL FormSobre
   LOCAL Fonte   := HFont():Add( "Arial", 0, - 13 )
   LOCAL Fonte2  := HFont():Add( "Arial", 0, - 27 )
   LOCAL o_Obtn1
	   PRIVATE oIcon := HIcon():AddResource( "ICON_1" ), ;
      oBmpLogo1 := HBitmap():AddFile( "res\sygecom2.bmp" )
	   SetToolTipBalloon( .T. )
	   INIT DIALOG FormSobre TITLE "Escolha Uma das Opções Abaixo"  ;
      AT 110, 100  SIZE 700, 350 NOEXIT NOEXITESC ;
      FONT Fonte ;
      ICON oIcon ;
      STYLE WS_DLGFRAME + WS_SYSMENU + DS_CENTER
	   @ 510, 5 OWNERBUTTON o_Obtn1;
      SIZE 190, 185 ;
      ON CLICK {|| sobre() } ;
      FLAT;
      BITMAP oBmpLogo1 FROM RESOURCE TRANSPARENT;
      TOOLTIP "Sygecom Informatica Ltda"
	   @ 30, 20 BUTTON btnOk CAPTION "DBFCDX - LOCAL"  SIZE 440, 80 ON CLICK {|| Escolha_emp( "L" ), EndDialog() } STYLE WS_TABSTOP;
      FONT Fonte2;
      TOOLTIP "Clique Aqui para Fazer Logon usando DBFCDX Local"
	   @ 30, 120 BUTTON "DBFCDX - LETO(REMOTO)" SIZE 440, 80 ON CLICK {|| Escolha_emp( "R" ), EndDialog() } STYLE SS_CENTER ;
      FONT Fonte2;
      TOOLTIP "Clique Aqui para Fazer Logon usando DBFCDX REMOTO"
	   @ 30, 230 BUTTON "Sair" SIZE 440, 80 ;
      ON CLICK {|| Escolha_emp( "S" ), EndDialog() } STYLE SS_CENTER ;
      FONT Fonte2;
      TOOLTIP "Clique Aqui para Sair"
	   ACTIVATE DIALOG FormSobre
	   RETURN
	FUNCTION Escolha_emp( tipo_emp )
	   IF tipo_emp = "L"
      PUBLIC vTipo_RDD := "DBFCDX"  // DBFCDX ou LETO
   ELSEIF tipo_emp = "R"
      PUBLIC vTipo_RDD := "LETO"  // DBFCDX ou LETO
   ELSEIF tipo_emp = "S"
      Finaliza_Sistema2()
   ENDIF
	   RETURN
	//************************
	FUNCTION Finaliza_Sistema2
	//************************
   DBCLOSEALL()
   Logo_sygecom()
   QUIT
	   RETURN .T.
	FUNCTION GERAFILE()
	   PUBLIC cFILE := GETENV( "temp" ) + "\TEMP" + ALLTRIM( STR( HB_RandomInt(9999 ) ) )
	   RETURN cFILE
	//*******************************************************************************
//**********************ROTINAS UTEIS********************************************
//*******************************************************************************


 

Link to comment
Share on other sites

Amiguinhos,

 

Para usar RDDLeto você precisará do módulo servidor e da biblioteca cliente. O Módulo servidor não precisa ser recompilado, basta usar o que já está executável, já a biblioteca cliente esta deve ser linkada ao seu aplicativo e você deve agregar o código que seja compatível com seu Harbour. Seja com Xis ou sem Xis.

Pegue o tópico desde o inicio e vá lendo até chegar no ponto em que já absorveu o bastante, pois a discussão se estendo por anos.

 

Link to comment
Share on other sites

Amiguinhos,

Não encontrei nada que ligue o NetIO com xHarbour tendo em vista que ele é nativo para Harbour. Creio que desde 2010 LetoDB e NetIO vem sendo implementados.

O NetIO Server geralmente vem no Harbour Binário ou Nightly, e a HBNetIO.lib pode ser agregada a compilação.

Talvez compilando os source mais atuais tanto do LetoDB como NetIO voce encontre wrapplers que possibilitem o uso.

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
×
×
  • Create New...