Jump to content
Fivewin Brasil

jfaguiar

Membros
  • Posts

    1,287
  • Joined

  • Last visited

  • Days Won

    21

Everything posted by jfaguiar

  1. Eu tenho as duas situações. Alguns clientes mais conservadores preferem fazer uma nf-e de entrada com referencia ao cupom devolvido, porém outros, simplesmente lançam a quantidade negativa na venda atual, o que consequentemente devolvem os itens devolvidos ao estoque e totaliza o valor dessas devoluções como um desconto. Acredito que, fiscalmente falando, é imprescindível que se faça também a nf-e de entrada.
  2. Retificações: Parceiros, acho que esse deve ser o maior assunto no momento. Vamos agir à tempo, vamos compartilhar tudo à respeito desse assunto tão sério. Estarei sempre correndo atrás de soluções e também à disposição para ajudar. Conto também com a colaboração de todos e sobretudo do dr. da NF-e Gilmer, desenvolvedor da maravilhosa! classe NFE_Util.prg para a dll da Flexdocs que utilizo. Obrigado.
  3. Parceiros, acho que esse deve ser o maior assunto no momento. Vamos agir à tempo, vamos compartilhar tudo à respeito desse assunto tão sério. Estarei sempre correndo atrás de soluções e também à disposição para ajudar. Conto também com a colaboração de todos e sobretudo do dr. da NF-e Gilmer . Obrigado.
  4. Estou repassando na íntegra o que a Flexdocs me passou rsrs...isso dar medo kkk
  5. Eu tenho uma rotina que interage com o meu dicionario de cadastros, onde constam todas as propriedades das tabelas, mas não é muito difícil de entender...: Note que o meu array aStruExcel contem varias colunas preenchidas a partir do meu dicionario de cadastro. no seu caso consider somente as colunas de Dbstruct: NOME DO CAMPO, TIPO DO CAMPO, TAMANHO DO CAMPO E QUANT CASAS DECIMAIS espero que possa ajudá-lo. qualquer coisa joaosiscom@hotmail.com FUNCTION GeraExcel(cCONDW,cCONDF) /* By João F. Aguiar e os amigos do forum www.fivewin.com.br */ LOCAL oDlg,oCbx,oExcel, oSheet,nREC := ARQCAD->( RECNO() ) LOCAL nPOSII,nPOSIF,cFORMAT,oText,aStruExcel := { } PRIVATE cCONDWHILE := IF(cCONDW == Nil,"!EOF()",cCONDW ),cTBLSELEC ... ARQCAD é a tabela a ser exportada para o excel // // ARQDICID é a tabela do meu dicionario de cadastro onde constam todas as propriedades das minhas tabelas. no seu caso pegue os dados a partir de dbstruct()... // // // .. aStruExcel no seu caso deve ser preenchida com os dados de dbstruct() // DbselectArea("ARQDICID") SEEK cTABELA WHILE TABELA == cTABELA .AND. !EOF() IF USO # " " .AND. cNIVEL >= ARQDICID->USO .AND. EMPTY(NOMCAD) .AND. !EMPTY(TITCAMPO) AADD(aStruExcel,{TRIM(NOMCAMPO),TRIM(TITCAMPO) +IF(!"MSEEK" $ UPPER(VALID),""," (P)") ,NOMOBJ,PICTURE,TRIM(VALID)+CONDIREL,; IF( cNIVEL < ARQDICID->EDITAVEL .OR. ARQDICID->EDITAVEL = " " ,.F.,.T.),; TAMCAMPO,.T.,0,AUTOINCR,AUTOATRIB,TIPCAMPO,PADR(POSICAMP,8),REALVIRT,FLUTUANTE,; DECIMAIS,GERAOCOR}) ENDIF DbSkip() ENDDO // IF !MsgYesNo("Confirma o envio desta tabela para o Excel ?",'Confirmação') RETURN Nil ENDIF // // .. neste momento aStruExcel já deverá está preenchida com as propriedades da tabela a ser enviada para o excel // oExcel := TOleAuto():New( "Excel.Application" ) oExcel:WorkBooks:Add() oSheet := oExcel:Get( "ActiveSheet" ) oSheet:Name := "Aba 1" nL := 1 nC := 0 FOR n = 1 TO LEN(aStruExcel) ++ nC IF aStruExcel[n,12] = "D" // 12 É o tipo do campo... voce pode monta esse array com directory() e constumizar este código. nLENFIELD := 10 ELSEIF aStruExcel[n,12] = "M" nLENFIELD := 80 ELSE nLENFIELD := aStruExcel[n,7] + 1 ENDIF IF LEN( aStruExcel[n,2] ) > nLENFIELD .AND. !aStruExcel[n,12] == "M" nLENFIELD := LEN( aStruExcel[n,2] ) ENDIF oSheet:Columns(nC):ColumnWidth := nLENFIELD oSheet:Cells(1,nC):Value := aStruExcel[n,2] NEXT // DbselectArea("ARQCAD") // ARQCAD é a tabela a ser exportada IF cCONDW == Nil DbGoTop() ENDIF // ... cCAMPO ... nome do campo da estrutura dbf // StruExcel[n,12] ...tipo do campo dbf c n d m .. WHILE &cCONDWHILE // ou !EOF() ++ nL nC := 0 FOR n = 1 TO LEN(aStruExcel) IF aStruExcel[n,14] == "V" // .OR. !aStruExcel[n,6] // eDITAVEL IF "->" $ aStruExcel[n,1] .AND. !"(" $ aStruExcel[n,1] ELSE LOOP ENDIF ENDIF ++ nC IF aStruExcel[n,12] $ "D" cCAMPO := "DTOC(" + aStruExcel[n,1] +")" oSheet:Cells( nL, nC ):Value := &cCAMPO ELSEIF aStruExcel[n,12] $ "N" IF !"COMBO" $ aStruExcel[n,4] // Picture nPOSII := nPOSIF := 0 IF aStruExcel[n,16] > 0 // Deciomais cCAMPO := "TRANSF(" + aStruExcel[n,1] +",'@E "+REPLIC("9",aStruExcel[n,7] - (aStruExcel[n,16]-1) )+; "."+REPLIC("9",aStruExcel[n,16]) + "')" ELSE cCAMPO := "STR(" + aStruExcel[n,1] +","+STR(aStruExcel[n,7],2) + ")" ENDIF nPOSII := AT("(",cCAMPO) nPOSIF := IF( AT(",",cCAMPO) > 0,AT(",",cCAMPO),AT(")",cCAMPO) ) cFORMAT := GeraNumFormat( SUBSTR(cCAMPO,nPOSIF+1),IF("TRANS" $ cCAMPO,.T.,.F.)) // MsgInfo("cCAMPO = "+cCAMPO +CRLF +; // "cFORMAT = "+cFORMAT) oSheet:Cells( nL,nC ):Set( "NumberFormat", cFORMAT) oSheet:Cells( nL, nC ):Value := &cCAMPO ELSE cCAMPO := aStruExcel[n,1] IF &cCAMPO > 0 VARAUXCG1 := TRIM( aStruExcel[n,5] ) // Carregando o array contido em VALID aITENSCMB := &VARAUXCG1 //VARAUXCG1 // IF &cCAMPO <= LEN(aITENSCMB) oSheet:Cells( nL, nC ):Value := aITENSCMB[&cCAMPO] ENDIF ENDIF ENDIF ELSEIF aStruExcel[n,12] $ "M" cCAMPO := TRIM(aStruExcel[n,1]) + " " cCAMPO := &cCAMPO nLINMEMO := MLCOUNT(cCAMPO,80) // FOR i = 1 TO nLINMEMO VARAUX1 := MEMOLINE(cCAMPO,80,i) IF !EMPTY(VARAUX1) IF i > 1 ++ nL ENDIF oSheet:Cells( nL, nC ):Value := VARAUX1 ENDIF NEXT ELSE // caractere cCAMPO := aStruExcel[n,1] oSheet:Cells( nL, nC ):Value := &cCAMPO ENDIF NEXT DbSkip() ENDDO oSheet:Cells( 1, 1 ):Select() oExcel:Visible := .T. DbGoTo(nREC) Return Nil ************************************************************************************** FUNCTION GeraNumFormat( cPICTURE,lTRANSF) // "#.##0,00 mascara valida para campos numericos LOCAL nTAMCAM,nDECIMA,cPICT,cCHRPRE,nPOSIPOINT cPICTURE := TRIM(cPICTURE) // Conteudo de cPICTURE IF lTRANSF // Se for uma mascara TRANSF() - "@E 999,999.99" IF AT(".",cPICTURE) = 0 RETURN("Geral") ENDIF cPICT := " " cCHRPRE := "#" FOR _i := 1 TO LEN(cPICTURE) cCHAR := SUBSTR(cPICTURE,_i,1) IF cCHAR == "9" IF SUBSTR(cPICTURE,_i+1,1) == "." cCHRPRE := "0" ENDIF cPICT += cCHRPRE ELSEIF cCHAR $ "," cPICT += "." ELSEIF cCHAR $ "." cPICT += "," ENDIF NEXT /* cCHRPRE := "#" nPOSIPOINT := AT(".",cPICTURE) IF nPOSIPOINT = 0 nPOSIPOINT := LEN(cPICTURE) cCHRPRE := "0" ENDIF IF nPOSIPOINT = 0 RETURN("Geral") ENDIF cPICT := " " FOR _i := 1 TO LEN(cPICTURE) cCHAR := SUBSTR(cPICTURE,_i,1) IF cCHAR == "9" IF _i = nPOSIPOINT-1 cCHRPRE := "0" ENDIF cPICT += cCHRPRE ELSEIF cCHAR $ "," cPICT += "." ELSEIF cCHAR $ "." cPICT += "," ENDIF NEXT */ RETURN( LTRIM(cPICT) ) ELSE // Se for uma mascara STR() // 2) cPICTURE := LEFT(cPICTURE,LEN(cPICTURE)-1) // tira o fecha parêntese // Fica assim 2 nPOSI := AT(",",cPICTURE) IF nPOSI = 0 // RETURN("Número") // dar erro em fwh 7.01 RETURN("Geral") // dar erro em fwh 7.01 //cPICT := REPLIC("9",VAL(cPICTURE) ) ELSE // Exemplo: 10,2 cPICT := REPLIC("#",VAL(LEFT(cPICTURE,nPOSI-1)) -2 ) + "0," +; REPLIC("0",VAL(SUBSTR(cPICTURE,nPOSI+1)) ) // ########0,00 RETURN(cPICT) ENDIF ENDIF RETURN(" ") *****************************************************************************
  6. Acho que vou Então kapiaba, mas eu teria que gerar tipo um hiperlink para o fw executar. E como fazer isso?
  7. Bom dia amigos. Será que é possível visualizar um pdf da web sem ter que fazer o download. Exemplo eu me conecto, visualizo a a lista de arquivos da pasta, salvo num Listbox e ao clicar abre a imagem conforme o endereço. Exemplo: ftp://xxxx.com.br/Boahora/12956395000180/T00225420009933149.pdf ftp://xxxx.com.br/Boahora/12956395000180/T00225420009933150.pdf ftp://xxxx.com.br/Boahora/12956395000180/T00225420009933151.pdf
  8. Conforme a Flexdocs, parece que prorrogaram para mes 04/2018... Prezado Sr. João Freire de Aguiar,A DLL será atualizada oportunamente, dentro do prazo previsto da NT 2016/002:disponibilização do Ambiente de homologação pela SEFAZ: 01/06/2017 (adiado para 03/07/2017)disponibilização do Ambiente de produção pela SEFAZ: 01/08/2017 (adiado para 02/10/2017)Data limite para uso da versão 3.10: 06/11/2017 - prorrogado para 02/04/2018.Cabe observar que vai haver mudança nos Web Services, assim só será possível ter uma versão de testes após a disponibilização do ambiente de homologação pela SEFAZ que vai ocorrer somente em 03/07/2017.Haverá custo de atualização para uso da nova versão para as licenças que foram adquiridas/ativadas antes do dia 30/11/2016. Todas as licenças adquiridas ou ativadas após o dia 30/11/2016 não terão custo de atualização.Atenciosamente,Equipe de Suporte»Importante:Reajuste do valor da licença a partir de janeiro/2017, veja: www.flexdocs.com.brwww.facebook.com/flexdocs
  9. Bom dia Kapiaba, blz. Você já sabe o prazo máximo para a implantação da nova versão da NF-e? Thanks
  10. Boa tarde amigos. Estou utilizando na TFtp e não encontrei um método que detecte a existência de um diretório. Usei o método oFTP:CreateDirectory(cFtpDirCli) e criou certinho a pasta, mas gostaria de executar esse comando somente se não existir. Obrigado Ops usei o método SetCurrentDirectory e deu certo. IF !oFTP:SetCurrentDirectory(cFtpDirCli) MsgInfo("Criando diretório "+cFtpDirCli) oFTP:CreateDirectory(cFtpDirCli) ENDIF
  11. Conseguiu Giovany!!! Deus te abençoe caríssimo. Meus sinceros agradecimentos a você e ao Kapiaba. vlwww
  12. Só pra finalizar, desculpe abusar da bondade...não tem como salvar todos os documentos da bandeja em uma unica imagem? Se for possível, é tudo que eu preciso!!!
  13. Olha NOIS aí denovo rsrs... Boa tarde Giovany. Não retorna, quando chega nessa linha ele trava: nDib:=(oScan:AcquireToFile(cFilescan)). Se eu colocar 2 documentos no scanner ele retorna zero nas dois documentos que ele puxa, porém quando tenta a terceita vez e chega nessa linha e não tem mais documento o programa trava e só sai finalizando tarefa. Agora um fato curioso, se eu segurar o segundo documento, simulando um papel enroscado, retorna -1 e sai normalmente. Compilei também com fw 13.07 + Harbour e deu o mesmo problema. Até tentei matar o objeto oScan:End() a cada loop, antes do enddo e reiniciar, mas não deu certo.
  14. Bom dia Giovany blz. Você usar harbour com Fivewin, é isso? Porque se for eu vou baixar.
  15. Éh, o do meu cliente meu é kodak i1120, mas o que vai rodar é um outro kodak mais parrudo. Mas muito obrigado mesmo Giovany. Vou fazer isso. Já falei com a galera la da Fivetech também pra ver se existe alguma solução.
  16. Boa noite Giovany. Então mas não gera error.log, porque trava e tenho que finalizar tarefa. Quanto ao hb_out.log não consta na pasta do aplicativo não. Pra ficar mais claro, estou utilizando: windows 7, 32 bits com 3 de ram. Vou te passar o projeto: ******************************************************************** IF EXIST TESTSCAN.EXE DEL TESTSCAN.EXE set fwdir=c:\fwh1307 set hdir=c:\xharbour1307 set bcdir=c:\bcc73 %hdir%\bin\harbour testscan2 /n /i%fwdir%\include;%hdir%\include %2 %3 > testscan.log %hdir%\bin\harbour tscan /n /i%fwdir%\include;%hdir%\include %2 %3 > tscan.log %bcdir%\bin\bcc32 -M -c -O2 -I%hdir%\include testscan.c > b32.bc %bcdir%\bin\bcc32 -M -c -O2 -I%hdir%\include tscan.c > b32.bc Rem gerando .res sobre o arquivo .rc IF EXIST TESTSCAN2.rc c:\bcc73\bin\brc32 -r TESTSCAN2 c:\bcc73\bin\ilink32 -Gn -aa -Tpe -s @BuildScan.Lnk Echo . pause IF ERRORLEVEL 1 GOTO LINKERROR TestScan2 GOTO EXIT :LINKERROR PAUSE * Applicacao Nao Foi Desenvolvida Com Sucesso. Veja ERRO.LOG * GOTO EXIT Echo. cls :EXIT ******************************************************************** c:\bcc73\lib\c0w32.obj + testscan2.obj + tscan.obj, + testscan2.Exe, + testscan2.Map, + c:\fwh1307\lib\fivehx.lib + c:\fwh1307\lib\fivehc.lib + twain.lib + c:\xharbour1307\lib\hbzip.lib + c:\xharbour1307\lib\zlib.lib + c:\xharbour1307\lib\rtl.lib + c:\xharbour1307\lib\vm.lib + c:\xharbour1307\lib\gtgui.lib + c:\xharbour1307\lib\lang.lib + c:\xharbour1307\lib\macro.lib + c:\xharbour1307\lib\rdd.lib + c:\xharbour1307\lib\dbfntx.lib + c:\xharbour1307\lib\dbfcdx.lib + c:\xharbour1307\lib\debug.lib + c:\xharbour1307\lib\common.lib + c:\xharbour1307\lib\tip.lib + c:\xharbour1307\lib\pp.lib + c:\xharbour1307\lib\dbffpt.lib + c:\xharbour1307\lib\codepage.lib + c:\xharbour1307\lib\hbsix.lib + c:\xharbour1307\lib\pcrepos.lib + c:\xharbour1307\lib\ct.lib + c:\xharbour1307\lib\png.lib + c:\bcc73\lib\cw32.lib + c:\bcc73\lib\psdk\msimg32.lib + c:\bcc73\lib\psdk\odbc32.lib + c:\bcc73\lib\psdk\rasapi32.lib + c:\bcc73\lib\psdk\nddeapi.lib + c:\bcc73\lib\psdk\psapi.lib + c:\bcc73\lib\psdk\iphlpapi.lib + c:\bcc73\lib\import32.lib,
  17. Pelo que pude perceber está travando quando acaba os documentos na bandeja e execeuta nDib := (oScan:AcquireToFile(cFilescan)), mas não tenho ideia de como resolver. Testei assim também e travou do mesmo jeito: nDib := TWAIN_ACQUIRETOFILENAME( 0, cFilescan ) // http://fivetechsupport.com/forums/viewtopic.php?f=3&t=24126 DLL STATIC FUNCTION TWAIN_ACQUIRETOFILENAME( hWnd AS LONG, cFile AS LPSTR ) AS LONG; PASCAL FROM "TWAIN_AcquireToFilename" LIB "eztw32.dll"
  18. Boa tarde meu amigo rsrsrs muito obrigado. Estamos quase lá, salvou cada documento em um arquivo jpg, os quais minha aplicação inclui na tabela TBASCAN.dbf , porém, está travando quando volta para a dialog. Será que está faltando algum ch #INCLUDE "Fivewin.ch" #include "Image.ch" FUNCTION Main() LOCAL oDlg,oLbx,oIco,nQTDIMG := 0 cLastFile := "aaaaaaaaa" PUBLIC ERRORED := .F.,cDRIVE := CurDrive()+":",cTIPODB := NIL PUBLIC CLR_FUNGET,CLR_FONGET,CLR_FUNLBX,CLR_FONLBX,CLR_FUNLBX2,CLRFUGETNE // CLR_FUNLBX := nRGB( 202,255,202) CLR_FUNLBX2 := nRGB( 255,255,255) CLR_FONLBX := nRGB( 0,0,0) CLR_FUNGET := nRGB( 255,255,174) CLR_FONGET := nRGB( 0,0,0) CLRFUGETNE := nRGB( 235,255,174) // nHeightScr:= 30 nWidthScr := 100 // REQUEST HB_LANG_PT HB_LANGSELECT( 'PT' ) REQUEST DBFCDX // Sem ads RddSetDefault("DBFCDX") // Sem ads SetHandleCount(40) // Define quantidade máxima de arquivos para aplicação // SET DELETED ON SET 3DLOOK ON SET DATE BRITISH SET EPOCH TO 1980 // // C:\BCC55\BIN\IMPLIB.EXE ACE32.LIB ACE32.DLL // IF !FILE("TBPSCAN.DBF") aSTRUCT := { } AADD(aSTRUCT,{'NOMEPAS','C',6,0 } ) AADD(aSTRUCT,{'DATA','D',8,0 } ) AADD(aSTRUCT,{'HORA','C',5,0 } ) DBCREATE("TBPSCAN", aSTRUCT) ENDIF IF !FILE("TBPSCAN.CDX") IF NETUSE("TBPSCAN","TBPSCAN",.F.,.F.,5) INDEX ON DESCEND(DTOS(DATA)+HORA) TAG DATA TO TBPSCAN INDEX ON NOMEPAS TAG NOMEPAS TO TBPSCAN DbCloseArea() ENDIF ENDIF IF NETUSE("TBPSCAN","TBPSCAN",.T.,.F.,5) SET INDEX TO TBPSCAN IF RECCOUNT() = 0 REGLOCK(10,.T.) DbUnlock() ENDIF ENDIF IF ERRORED CLOSE DATABASE RETURN Nil ENDIF nNUMDOC := 0 // 0042707201.tif lChDir("E:\Msscan") DEFINE FONT oFontLbl NAME "Arial" SIZE 0, -12 BOLD DbSelectArea("TBPSCAN") DEFINE DIALOG oDlg FROM 01,01 TO 28,35 TITLE "Siscom Multi" COLOR "N/B" oDlg:Cargo := .F. nWidthLb := oDlg:nWidth() * IF(oDlg:nWidth() < 411, 0.480009,0.489900) // 0.476190476 nHeightLb := HeightLb( oDlg:nHeight() ) - 10 @ LINS(0.5),COLS(01) SAY "Selecione a Pasta - Click Duplo Edita" COLOR "W+/B" FONT oFontlbl @ 1.3,0.700 LISTBOX oLbx; FIELDS TBPSCAN->NOMEPAS,DTOC(TBPSCAN->DATA)+" - "+TBPSCAN->HORA; SIZE nWidthLb,nHeightLb; // Comprimento,Altura HEADERS "Nome Pasta","Data Criação" OF oDlg COLORS CLR_FONLBX,CLR_FUNLBX @ oDlg:nHeight()/2-19,oDlg:nWidth()/2-70 BTNBMP SIZE 30,15 Pixel; FILENAME "&cDRIVE\SISCOM\bitmaps\BTNOK.bmp"; ACTION PreparaScaner() @ oDlg:nHeight()/2-19,oDlg:nWidth()/2-35 BTNBMP SIZE 35,15 Pixel; FILENAME "&cDRIVE\SISCOM\bitmaps\BTNCANC.bmp"; ACTION oDlg:End() oLbx:bLDblClick:= { | nKEY,nRow, nCol | EditListBox( nKEY, nRow , nCol,oLbx) } ACTIVATE DIALOG oDlg CENTERED RETURN Nil **************************************************************** STATIC FUNCTION PreparaScaner() local oLbx,oDlg LOCAL oImage, lSetAlpha := .t. cPASTA := CurDrive() + ":\MsScan\" + TRIM(TBPSCAN->NOMEPAS) IF !lISDIR(cPASTA) lMkDir(cPASTA) ENDIF lChDir(cPASTA) IF !FILE("TBASCAN.DBF") aSTRUCT := { } AADD(aSTRUCT,{'NOMEARQ','C',14,0 } ) AADD(aSTRUCT,{'DATA','D',8,0 } ) AADD(aSTRUCT,{'HORA','C',5,0 } ) AADD(aSTRUCT,{'STATUS','N',1,0 } ) DBCREATE("TBASCAN", aSTRUCT) ENDIF IF !FILE("TBASCAN.CDX") IF NETUSE("TBASCAN","TBASCAN",.F.,.F.,5) INDEX ON NOMEARQ TAG NOMEPAS TO TBASCAN DbCloseArea() ENDIF ENDIF IF NETUSE("TBASCAN","TBASCAN",.T.,.F.,5) SET INDEX TO TBASCAN ENDIF DbSelectArea("TBASCAN") aBITMAP := { ReadBitmap( 0, "&cDRIVE\SISCOM\bitmaps\LevelX.bmp" ),; // Sem Led ReadBitmap( 0, "&cDRIVE\SISCOM\bitmaps\Level2.bmp" )} // Verde DEFINE DIALOG oDlg FROM 0, 0 TO 38,160 ; TITLE "Siscom Multi - Pasta: "+cPASTA COLOR "N/B" nWidthLb := oDlg:nWidth() * IF(oDlg:nWidth() < 411, 0.480009,0.489900) nHeightLb := HeightLb( oDlg:nHeight() ) @ 0.2,0.600 LISTBOX oLbx; FIELDS TBASCAN->NOMEARQ,DTOC(TBASCAN->DATA)+" - "+TBASCAN->HORA,aBITMAP[Max(1,TBASCAN->STATUS)]; SIZE 184,250; // Comprimento,Altura HEADERS "Nome Arquivo","Digitalização","Status" OF oDlg COLORS CLR_FONLBX,CLR_FUNLBX @ 0.2,24.5 IMAGE oImage SIZE 433, 283 OF oDlg SCROLL // ADJUST 246 oImage:Progress( .f. ) oDlg:Cargo := .F. @ LINS(21.8),COLS(01) SAY "Informe o nome do arquivo" COLOR "W+/B" FONT oFontlbl @ LING(22.6),COLG(01) GET nNUMDOC PICT "99999999" @ oDlg:nHeight()/2-22,085 BtnBmp oBt1 File "&cDRIVE\SISCOM\bitmaps\Scanner.bmp" size 60,20 Pixel Prompt "Digitalizar" 2007 Left; ACTION Digitaliza(oLbx,oDlg) Of oDlg @ oDlg:nHeight()/2-22,150 BTNBMP SIZE 40,20 Pixel; FILENAME "&cDRIVE\SISCOM\bitmaps\BTNCANC.bmp"; ACTION oDlg:End() OF oDlg oLbx:bChange := {|| ExibImg( cPASTA + "\" + TRIM(TBASCAN->NOMEARQ),oImage ) } ACTIVATE DIALOG oDlg CENTERED // ON INIT ExibImg( cPASTA + "\" +TRIM(TBASCAN->NOMEARQ,oImage) ) TBASCAN->( DbCloseArea() ) cPASTA := CurDrive() + ":\MsScan" lChDir(cPASTA) RETURN Nil **************************************************************** Function Digitaliza(oLbxr,oDlgr) // MsScan( cFile, nType, nRes, lHide, lInterface, nPaper ) oScan := TScan32():New( "" ) aFilesScan := {} oScan:PixelType( 1 ) oScan:SetRes( 150 ) // Resolucion 150 by Default. oScan:SetHide( .T. ) oScan:SetMultiTransfer(1) // escolha 1 para scanear varias paginas //oScan:EnableDuplex(1) oScan:SetFileFormat(4) // oScan:SetJpegQuality(80) // 75 default nSeqImg := 0 WHILE .T. nSeqImg++ //cImagem:=DIR_TEMP()+"_IMG_"+LIMPO(nSeqImg,.f.)+".JPG" cFilescan := STRZERO(nNUMDOC,8) + STRZERO(nSeqImg,2)+ ".Jpg" AADD(aFilesScan,cFilescan) nDib:=(oScan:AcquireToFile(cFilescan)) IF nDib < 0 EXIT ENDIF syswait(.5) oScan:FreeDib() syswait(.3) SEEK cFilescan IF REGLOCK(10,(EOF()) ) REPLACE NOMEARQ WITH cFilescan,DATA WITH DATE(),HORA WITH TIME() REPLACE STATUS WITH 1 DbUnlock() ENDIF ENDDO oScan:End() RELEASE oScan* oLbxr:Refresh() oDlgr:SetFocus() Return NIL *********************************************************************************** FUNCTION ExibImg( cFILE,oImg ) IF FILE(cFILE) oImg:LoadBmp(cFILE) oImg:Refresh() ENDIF RETURN Nil **************************************************************** STATIC FUNCTION EditListBox( nKEY, nRow, nCol,oLbx) LOCAL u,nREGANT := 0 IF nCol > 0 nCOL := oLbx:nAtCol( ncol ) IF nCOL # 1 nCOL := 1 ENDIF ENDIF // IF REGLOCK(10,.F.) u := ( oLbx:cAlias )->( FieldGet(1) ) if oLbx:lEditCol( nCOL , @u ) FieldPut(1,u ) IF !EMPTY(u) .AND. EMPTY(DATA) REPLACE DATA WITH DATE(),HORA WITH TIME() nREGANT := RECNO() ENDIF ENDIF DbUnlock() ENDIF IF nREGANT > 0 IF REGLOCK(10,.T.) DbUnlock() DbGoto(nREGANT) ENDIF ENDIF oLbx:Refresh() RETURN Nil *********************************************************************************** FUNCTION Netuse(ctabe, capelid,lcompart,lLeitura,tempo,cIndOpen) LOCAL sempre // ,lLeitura := lcompart LOCAL oText IF SELECT(capelid) > 0 RETURN(.T.) ENDIF sempre := (tempo = 0) WHILE (sempre .OR. tempo > 0) .AND. INKEY()<>27 MsgRun( "Abrindo tabela "+cTabe, "Aguarde...",; { || DbUseArea(.T.,cTIPODB,ctabe,capelid,lcompart,lLeitura) } ) //DbUseArea(.T.,cTIPODB,ctabe,capelid,lcompart,lLeitura) // 1 = Novaarea // 2 = Drive (dbfcdx,topconec... // 3 = Tabela // 4 = Alias // 5 = Compartilhado ou nao .T. .F. // 6 = Leitura .t. .f. IF !NetErr() IF !cIndOpen == Nil IF !"CDX" $ UPPER(cIndOpen) cIndOpen += ".CDX" ENDIF IF FILE(cIndOpen) SET INDEX TO (cIndOpen) ELSE MsgAlert("Prezado usuário,"+CRLF+; "Um arquivo de índice denominado "+cIndOpen+" não foi encontrado."+CRLF+; "Causa provável: Alguém solicitou uma reorganização da base de dados"+CRLF+; "e não lhe avisou para sair do sistema.") ERRORED := .T. ENDIF ENDIF RETURN(.T.) ENDIF INKEY(1) -- Tempo ENDDO ERRORED := .T. IF INKEY() # 27 MsgStop("A tabela "+ cTABE +" não está disponível. - Origem: "+ProcName(1) ) ENDIF RETURN(.F.) ************************************************************************** FUNCTION LINS( __NR_ROW ) && linha say RETURN( __NR_ROW*0.795 ) //--------------------------------------------------------------------------- FUNCTION COLS( __NR_COL ) && coluna say RETURN( __NR_COL/1.5 ) ****************************************************************************** FUNCTION LING( __NR_ROW ) && linha get RETURN( ((__NR_ROW*0.92)-0.02)+ IF(__NR_ROW>18,0.05,0) ) //---------------------------------------------------------------------------- FUNCTION COLG( __NR_COL ) && coluna do get RETURN( __NR_COL/2.00 ) ****************************************************************************** FUNCTION LINR( __NR_ROW ) && linha radio RETURN( (__NR_ROW*0.96) - 0.02 ) //---------------------------------------------------------------------------- FUNCTION COLR( __NR_COL ) && coluna radio RETURN(__NR_COL/1.8) ****************************************************************************** FUNCTION LINB( __NR_ROW ) && linha buttom RETURN((__NR_ROW*0.67)+0.10) //---------------------------------------------------------------------------- FUNCTION COLB( __NR_COL ) && coluna button RETURN( __NR_COL/1.5 ) ****************************************************************************** FUNCTION LIND( __NR_ROW ) && linha dbcombo RETURN( (__NR_ROW*0.85) + IF(__NR_ROW>10,0.05,0) + IF(__NR_ROW>17,0.05,0) ) //---------------------------------------------------------------------------- FUNCTION COLD( __NR_COL ) && coluna dbcombo RETURN((__NR_COL/2)+0.20) ****************************************************************************** FUNCTION COLC( __NR_COL ) && coluna checkbox RETURN(__NR_COL/1.75) ****************************************************************************** ****************************************************************************** FUNCTION Reglock(tempo,lAppend,cAREA) * Objetivo..: Tenta travar o registro atual *************************************************************************** LOCAL sempre //IF !cAREA == Nil // DbSelectArea(cAREA) //ENDIF sempre := (tempo = 0) cursorwait() DO WHILE (sempre .OR. tempo > 0) .AND. INKEY()<>27 IF !lAppend IF RLOCK() CursorArrow() RETURN(.T.) // bloqueado ENDIF ELSE DbAppend() // APPEND BLANK IF .NOT. NETERR() CursorArrow() RETURN(.T.) ENDIF ENDIF INKEY(.5) && espera 1/2 segundo tempo := tempo - .5 ENDDO CursorArrow() MsgAlert("O Arquivo "+Alias() +" nao está disponível. Operação cancelada !") RETURN(.F.) *************************************************************************** FUNCTION HeightLb( nHeight ) // Controle a altura da listbox // Criada em 25/01/2008 por João Freire IF nHeight <= 350 RETURN( nHeight * 0.391111 ) // 0.369649805 ELSE RETURN( nHeight * 0.418888 ) ENDIF *************************************************************************** FUNCTION xSetFocus( oObj ) // Força o retorno do foco para um determinado objeto, a partir de uma // sub-rotina chamada a partir de um GET; // substitui oLbx:setfocus() que nããããããão funciona. *---------------------------------------------------------------------------- LOCAL oTempo := '' DEFINE TIMER oTempo INTERVAL 10 OF oObj:oWnd; ACTION ( oObj:SetFocus(), oTempo:Deactivate() ) // ACTION ( oObj:SetFocus(), oObj:SetPos(0), oTempo:Deactivate() ) ACTIVATE TIMER oTempo Return( Nil ) *****************************************************************************
  19. Boa tarde Giovany, Blz. Então os comandos abaixo não estão sendo interpretado Tscan32.dll: Message not found: TSCAN32:AUTOFEED Message not found: TSCAN32:SETMULTITRANSFER Message not found: TSCAN32:ENABLEDUPLEX Será que é por causa da versão da minha lib e dll? A versão da minha EZTW32.DLL é 2.0.5.0 e a minha TWAIN.LIB e uma de 24/01/2003. Você não teria uma versão atualizada por aí? Obrigado
  20. Olá Amigos. Estou criei uma aplicação para Tscan, mas gostaria de salvar um jpg para cada documento digitalizado. Percebi que quando o método ScanFive( nType, nRes, 0 ,lHide ) é executado, se houver 5 folhas na bandeja, esse método puxa todas, porém do documento digitalizado salvo em seguida com o método oScan:ClipBoardToFile( cFile ) assume a imagem somente do primeiro documento que o scanner puxou. Alguém pode dar uma luz Obrigado
  21. Olá João. É um código simples e está acontecendo num aplicativo que fica sendo executado minimizado buscando cupons a serem impressos em qualquer um dos micros. A rotina que faz isto é ImprimeCupomRede(oLbxr,oDlgr) que pega vendas para imprimir cupons e as imprime: segue o código: #INCLUDE "FiveWin.ch" PROCEDURE MAIN() LOCAL oDlg,oLbx,oFONTSCR PUBLIC cECF := "NENHUMA",ERRORED := .F. PUBLIC nNUMLOJA := 1,cUSUARIO := "PEROLA " // PUBLIC CLR_FUNGET,CLR_FONGET,CLR_FUNLBX,CLR_FONLBX,CLR_FUNLBX2,CLRFUGETNE CLR_FUNLBX := nRGB( 202,255,202) CLR_FUNLBX2 := nRGB( 255,255,255) CLR_FONLBX := nRGB( 0,0,0) CLR_FUNGET := nRGB( 255,255,174) CLR_FONGET := nRGB( 0,0,0) CLRFUGETNE := nRGB( 235,255,174) // PUBLIC cTIPODB := NIL nHeightScr:= 30 nWidthScr := 100 cDRVBACK := " " cACESSMAIL := "00:00:00" // PRIVATE aPEDIDOS aPEDIDOS := {} private hBorland := LoadLibrary( "bwcc32.dll" ) lWHITE := .F. REQUEST HB_LANG_PT HB_LANGSELECT( 'PT' ) REQUEST HB_LANG_PT HB_LANGSELECT( 'PT' ) // REQUEST DBFCDX RddSetDefault("DBFCDX") SET DELE ON SET 3DLOOK ON SET DATE BRITISH SET EPOCH TO 1980 // IF !"FNT" $ CURDIR() cPATH := "H:\SISCOM\ARQSCDX" cDRIVE := "H:" IF !lISDIR(cDRIVE+"\SISCOM") MsgAlert("O seu servidor não está online."+CRLF+; "Pressine ok para que o sistema tentar localizá-lo") WNetAddCon("\\server\C",,cDRIVE) Syswait(0.5) IF lISDIR(cDRIVE+"\SISCOM") MsgInfo("Mapeamento ok") ENDIF ENDIF ELSE cPATH := "E:\PEROLA\ARQSCDX" cDRIVE := "E:" ENDIF cPATHVAR := "G" // cTMPPEDD := GERA_TMP("DBF",0) ERRORED := .F. IF NETUSE(CurDrive()+":\SISCOM\ARQCFG","ARQCFG",.F.,.F.,20) IF !EMPTY(ARQCFG->NOMEECF) cECF := TRIM(ARQCFG->NOMEECF) ENDIF IF "SISCOM" $ UPPER(CURDIR() ) cPATH := TRIM(ARQCFG->PATH) ELSE nPOSIBAR := AT("\",Curdir() ) cPATH := CurDrive()+":\" + LEFT(Curdir(),nPOSIBAR) + "ARQSCDX" ? cPATH ENDIF DbCloseArea() ELSE RETURN Nil ENDIF SET DEFAULT TO &cPATH // IF Netuse("ARQPARCD","ARQPARCD",.T.,.F.,5) DbGotop() ENDIF IF Netuse("ARQPARAM","ARQPARAM",.T.,.T.,5) DbGotop() ENDIF IF Netuse("ARQPEDC","ARQPEDC",.T.,.F.,5) SET INDEX TO ARQPEDC ENDIF IF Netuse("ARQPEDD","ARQPEDD",.T.,.F.,5) SET INDEX TO ARQPEDD MATESTRU := DBSTRUCT() AADD(MATESTRU,{'NRECNO','N',7,0 } ) AADD(MATESTRU,{"PEDNPROD","C",50,0} ) AADD(MATESTRU,{"TOTTAMANH","N",8,3} ) DBCREATE(cTMPPEDD, MATESTRU) IF Netuse(cTMPPEDD,"TMPPEDD",.F.,.F.,5) GO TOP ENDIF ENDIF IF Netuse("ARQPROD","ARQPROD",.T.,.T.,5) SET INDEX TO ARQPROD ENDIF IF Netuse("ARQPLC","ARQPLC",.T.,.T.,5) SET INDEX TO ARQPLC ENDIF IF Netuse("ARQCLI","ARQCLI",.T.,.T.,5) SET INDEX TO ARQCLI ENDIF IF Netuse("ARQUSER","ARQUSER",.T.,.T.,5) SET INDEX TO ARQUSER ENDIF IF ERRORED CLOSE DATABASE RETURN Nil ENDIF // IF cECF == "DARUMAFW" xDll := LoadLibrary("DarumaFrameWork.dll") // ebuscarportavelocidade // // Testa de Impressora Fiscal esta Ligada iRetorno := VerificarImpressoraLigada() /* iRetorno estava com -6 então alterei as tags abaixo <ECF> <Auditoria>0</Auditoria> para <Auditoria>1</Auditoria> <PortaSerial>DEFAULT</PortaSerial> para <PortaSerial>COM5</PortaSerial> <Velocidade>9600</Velocidade> para <Velocidade>115200</Velocidade> */ IF iRetorno = 1 msginfo( "Impressora "+cECF + " Ligada" ) cDATA := SPACE(10) nRETSTATUS := VerificarStatus("21",cDATA) // rConsultarStatusEspecifico_SAT_Daruma - retorno AAAAMMDDhhmmss. // 20161226085902 dDATA := SUBSTR(cDATA,7,2) + "/" + SUBSTR(cDATA,5,2) + "/" + LEFT(cDATA,4) IF DATE() - CTOD(dDATA) > 3 MsgAlert("Última transferência para a Sefaz ocorreu em "+dDATA+"." + CRLF+; "Evite bloqueio do equipamento, favor comunicar ao" + CRLF+; "desenvolvedor do aplicativo" ) ENDIF Else //IF !MsgYesNo("Impressora "+cECF + " Desligada"+CRLF+; // "Continua ?",'Confirmação') // Return nil //ENDIF MsgAlert( "Impressora "+cECF + " Desligada" ) cECF := "NENHUMA" ENDIF ELSEIF cECF == "DARUMA" xDll := LoadLibrary("Daruma32.DLL") ENDIF // IF cECF == "NENHUMA" .AND. !"FNT" $ UPPER( CURDIR() ) CLOSE DATABASE RETURN Nil ENDIF // lIMPREDE := .F. MENU oMenu 2007 MENUITEM "&Rotinas Sat"; ACTION RotinasEcf(); MESSAGE "Encerra a aplicação" MENUITEM "&Imprime Cupons Rede"; ACTION ImprimeCupomRede(); MESSAGE "Imprime Cupons da Rede" MENUITEM "Sai&r..." ; ACTION iif( MsgYesNo( "Sai do sistema?","Confirmação"),oWnd:End(),); MESSAGE "Encerra a aplicação" ENDMENU // DEFINE WINDOW oWnd ; // Define a janela principal do sistema TITLE "MultSystems Softwares & Networks Ltda - By J. F. Aguiar - Vr.3.0.0DT - E-mail: joaosiscom@hotmail.com"; MENU oMenu DEFINE IMAGE oBmp FILE ("&cDRIVE\SISCOM\BITMAPS\LogoLourian.Jpg") ADJUST oWnd:bPainted = { | hDC | PalBmpDraw( hDC, 0, 0, oBmp:hBitMap ) } // //Define uma barra de ferramentas p/ o sistema DEFINE BUTTONBAR oBar OF oWnd DEFINE BUTTON FILE "&cDRIVE\SISCOM\BITMAPS\CALC.BMP" OF oBar ; ACTION WinExec( "Calc" ) ; TOOLTIP "Calculadora" ; MESSAGE "Aciona a calculadora" DEFINE BUTTON FILE "&cDRIVE\SISCOM\BITMAPS\EXIT.BMP" OF oBar ; ACTION iif( MsgYesNo( "Sai do sistema ?","Confirmação"),oWnd:End(),) ; TOOLTIP "Sair" ; MESSAGE "Encerra a execução do sistema" SET MESSAGE OF oWnd TO ; "Base de Dados: "+cPATH + " | Empresa: "+IF(nNUMLOJA=1," - Matriz"," - Filial 1") + " | " + "Usuário: "+cUSUARIO + " | " + "[F3] Pesquisa Tabelas" CENTERED KEYBOARD DATE TIME //"Base de Dados: "+cPATH + " | " + "Usuário: "+cUSUARIO + " | " + "[F3] Pesquisa Tabelas" CENTERED KEYBOARD DATE TIME ACTIVATE WINDOW oWnd MAXIMIZED //Ativa a janela principal do sistema CLOSE DATABASE RETURN Nil ***************************************************************************** STATIC FUNCTION RotinasEcf() LOCAL oDlg,oLbx,oFONTSCR IF lIMPREDE MsgAlert("Você está em mode de impressão de cupons da rede !"+CRLF+; "Para finalizar pressione a tecla ESC e alguarde alguns"+CRLF+; "segundo.") RETURN Nil ENDIF // PRIVATE oCOMANDA,nCOMANDA,oPROXCMD,nPROXCMD PRIVATE oNOMCLI,cNOMCLI,oVALORC,nVALORC,nREC PRIVATE VCDTVEN,nLASTKEY // nCOMANDA:=nLASTKEY := 0 VDESCONT:=VVALDESC:=nPUNIT:=0 // DbSelectArea("Arqpedc") DbSetOrder(4) DbGobottom() DbSkip(-10) SET RELATION TO PEDCLI INTO ARQCLI // DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 10,10 // 10,-10 DEFINE DIALOG oDlg FROM 01,01 TO 30,100 TITLE "Impressão de Cupons Fiscais - Impressora Conectada: "+cECF FONT oFONTSCR STYLE nOr( WS_VISIBLE, WS_OVERLAPPEDWINDOW ) oDlg:Cargo := .F. // nWidthLb := oDlg:nWidth() * IF(oDlg:nWidth() < 411, 0.480009,0.489900) // 0.476190476 nHeightLb := HeightLb( oDlg:nHeight() ) - 16 @ 2.0,0.700 LISTBOX oLbx; FIELDS STR(ARQPEDC->PEDORC,6),STR(ARQPEDC->PEDPED,6),DTOC(ARQPEDC->PEDDEMI),STR(ARQPEDC->PEDVORC,10,2),LEFT(ARQCLI->CLIRAZAO,20),ARQPEDC->PEDSIT,ARQPEDC->PEDCHVACES; SIZE nWidthLb,nHeightLb; // Comprimento,Altura HEADERS "Orçamento","Pedido","Emissão"," Valor","Cliente","Sit","Chave de Acesso"; OF oDlg COLORS CLR_FONLBX,CLR_FUNLBX // @ 08,004 Button oBtnOk Prompt "&Imprime" Size 60,15 Pixel ACTION PreparaImpressao(oLbx,oDlg) // Imprime @ 08,068 Button oBtnCancel Prompt "&Visualiza Itens" Size 60,15 Pixel ACTION SeleOpcc(0,"V",oLbx,oDlg) @ 08,132 Button oBtnCancel Prompt "&Pesquisa" Size 60,15 Pixel ACTION SeleOpcc(0,"P",oLbx,oDlg) // @ oDlg:nHeight()/2-19,004 Button oBtnOk Prompt "&Cancela CF-e Sefaz" Size 60,15 Pixel; ACTION CancelaCfeSefaz(oLbx,oDlg) @ oDlg:nHeight()/2-19,068 Button oBtnCancel Prompt "&Cancela CF-e Memória" Size 60,15 Pixel; ACTION CancelaCfeMemoria() @ oDlg:nHeight()/2-19,oDlg:nWidth()/2-35 BTNBMP SIZE 32,15 Pixel; FILENAME "&cDRIVE\SISCOM\bitmaps\BTNCANC.bmp"; ACTION oDlg:End() oLbx:bKeyDown := { | nKey | SELEOPCC(nKEY," ",oLbx,oDlg) } oLbx:nClrPane := { || IIF( lWHITE,(lWHITE := .F.,CLR_FUNLBX),(lWHITE := .T.,CLR_FUNLBX2)) } ACTIVATE DIALOG oDlg CENTERED // Ativa a janela de dialog SET RELATION TO RETURN Nil ***************************************************************************** STATIC FUNCTION PreparaImpressao(oLbxr,oDlgr) PRIVATE nCDCLI,oCDCLI cOBJETOS := "oCDCLI" IF ARQPEDC->PEDGPED # "S" MsgAlert("Pedido não gerado. Impossível imprimir cupom fiscal") RETURN Nil ENDIF IF !EMPTY(ARQPEDC->PEDCHVACES) MsgAlert("Cupom fiscal já enviado para o Sefaz.") RETURN Nil ENDIF // IF EMPTY(ARQPEDC->PEDSTRECE) cCNPJ_CPF:= IF( !EMPTY(ARQCLI->CLICGC),ClearChar(ARQCLI->CLICGC,{".","-","/"}),SPACE(14)) // 53.032.314/0001-32 53032314000132 22546065300 ELSE cCNPJ_CPF := LEFT(ARQPEDC->PEDSTRECE,14) ENDIF nCDCLI :=1 cNOMCLI := LEFT(ARQCLI->CLIRAZAO,30) cFPAGTO := IF(ARQPEDC->PEDTVEN = 1,"Dinheiro ","Cartao Credito ") DEFINE DIALOG oDlg FROM 5, 5 TO 23,70 TITLE "Prepara cupom fiscal" oDlg:Cargo := .F. @ LINS(01.0),COLS(02) SAY "Nº Comanda:" @ LINS(01.0),COLS(36) SAY "Valor:" @ LING(02.0),COLG(02) GET nCOMANDA PICT '999999' WHEN 1>2 @ LING(02.0),COLG(36) GET ARQPEDC->PEDVORC PICT '999999.99' WHEN 1>2 // @ LINS(03.2),COLS(02) SAY "Cód. Cliente.:" @ LINS(03.2),COLS(12) SAY "Nome Cliente.:" @ LING(04.0),COLG(02) GET nCDCLI PICT "999999" WHEN .F. @ LING(04.0),COLG(12) GET oNOMCLI VAR cNOMCLI PICT "@!" WHEN nCDCLI=1 .OR. nCDCLI=169 COLORS CLR_FONGET,CLR_FUNGET // @ LINS(05.2),COLS(02) SAY "Cpf/Cnpj:" @ LING(06.0),COLG(02) GET cCNPJ_CPF PICT "99999999999999" WHEN nCDCLI=1 COLORS CLR_FONGET,CLR_FUNGET // @ LINS(07.2),COLS(02) SAY "Forma Pagamento:" @ LING(08.0),COLG(02) GET cFPAGTO // @ oDlg:nHeight()/2-19,oDlg:nWidth()/2-70 BTNBMP SIZE 30,15 Pixel; FILENAME "&cDRIVE\SISCOM\bitmaps\BTNOK.bmp"; ACTION (oDlg:Cargo := .T.,oDlg:End() ) @ oDlg:nHeight()/2-19,oDlg:nWidth()/2-35 BTNBMP SIZE 32,15 Pixel; FILENAME "&cDRIVE\SISCOM\bitmaps\BTNCANC.bmp"; ACTION oDlg:End() ACTIVATE DIALOG oDlg CENTERED IF !oDlg:Cargo RETURN Nil ENDIF // // msginfo( "antes após dialog de edição antes de teste de validade "+cCNPJ_CPF) IF !EMPTY(cCNPJ_CPF) // 53.032.314/0001-32 53032314000132 22546065300 VARAUX1 := TRIM(cCNPJ_CPF) IF LEN(VARAUX1) = 11 //cpf VARAUX2 := TRANSF(VARAUX1,"@R 999.999.999-99") ELSEIF LEN(VARAUX1) = 14 //cnpj VARAUX2 := TRANSF(VARAUX1,"@R 99.999.999/9999-99") ELSE MsgAlert("CPF inválido !") RETURN Nil ENDIF /* IF !CHKCGCCPF(VARAUX2) MsgAlert("CPF inválido !") RETURN Nil ENDIF */ ENDIF // ImprimeCupom() // oLbxr:Refresh() oDlgr:SetFocus() RETURN nil ***************************************************************************** Static FUNCTION SeleOpcc(nKey,cOrigPesq,oLbx,oDlg) LOCAL oDlgp // ,oWndp LOCAL oDlgc,oLbxc IF nKey==VK_RETURN oDlg:Cargo := .T. oDlg:End() RETURN ELSEIF nKey==VK_ESCAPE oDlg:End() RETURN ENDIF DO CASE CASE cOrigPesq = "V" *............. TMPPEDD->( DbZap() ) *............. nVALORCP := 0 DbSelectArea("ARQPEDD") SEEK STR(ARQPEDC->PEDORC,6) + ARQPEDC->PEDDORC WHILE PEDORC = ARQPEDC->PEDORC .AND. PEDDORC == ARQPEDC->PEDDORC .AND. !EOF() nREC := RECNO() // ARQPEDD nVALORCP += ( PEDVAL * PEDQTDE ) DbSelectArea("TMPPEDD") DbAppend() FOR i = 1 TO FCOUNT() // quant. de campos cCAMPO := "ARQPEDD->"+FIELD(i) IF TYPE(cCAMPO) $ "CDNLM" FIELDPUT(i,&cCAMPO ) ENDIF NEXT REPLACE NRECNO WITH nREC // DbSelectArea("ARQPEDD") DbSkip() ENDDO // DbSelectArea("TMPPEDD") DbGoTop() SET RELATION TO PEDPROD INTO ARQPROD DEFINE FONT oFontv NAME "Ms Sans Serif" SIZE 10,10 // 0, -10 DEFINE DIALOG oDlgc RESOURCE "CONSITEMV" FONT oFontv oDlgc:Cargo := .F. REDEFINE LISTBOX oLbxc ; FIELDS LEFT(TMPPEDD->PEDPROD,8),LEFT(ARQPROD->ESTPROD,33),STR(TMPPEDD->PEDQTDE,8,2),TRANSF(TMPPEDD->PEDVAL,"@E 9,999.999"),TRANSF(TMPPEDD->PEDVAL*TMPPEDD->PEDQTDE,"@E 99,999.999"); SIZES 56, 320; HEADERS "CODIGO","PRODUTO"," QTDE","PR. UNIT"," TOTAL"; ID 131 OF oDlgc COLORS CLR_FONLBX,CLR_FUNLBX //REDEFINE GET ARQPEDC->PEDORC ID 132 OF oDlgc PICTURE "999999" WHEN 1>2 //REDEFINE GET nVALORCP ID 133 OF oDlgc PICTURE "99999.99" WHEN 1>2 REDEFINE BUTTON ID 132 OF oDlgc ACTION oDlgc:End() // Sair ACTIVATE DIALOG oDlgc CENTERED // tiva a janela de dialogo // CASE cOrigPesq = "P" nSEQUEN := 0 DEFINE DIALOG oDlgP FROM 1, 1 TO 25,50 TITLE "Siscom" // oDlgp:Cargo := .F. @ LINS(01),COLS(02) SAY "Informe o Pedido:" @ LING(02),COLG(02) GET nSEQUEN PICTURE "999999" COLORS CLR_FONGET,CLR_FUNGET // @ oDlgp:nHeight()/2-19,oDlgp:nWidth()/2-70 BTNBMP SIZE 30,15 Pixel; FILENAME "&cDRIVE\SISCOM\bitmaps\BTNOK.bmp"; ACTION (oDlgp:Cargo := .T.,oDlgp:End() ) @ oDlgp:nHeight()/2-19,oDlgp:nWidth()/2-35 BTNBMP SIZE 32,15 Pixel; FILENAME "&cDRIVE\SISCOM\bitmaps\BTNCANC.bmp"; ACTION oDlgp:End() ACTIVATE DIALOG oDlgp CENTERED //Ativa a janela de dialogo // IF oDlgp:Cargo CursorWait() DbSelectArea("ARQPEDC") DbSetOrder(4) SET SOFTSEEK ON //DbSetOrder(1) SEEK nSEQUEN IF PEDPED # nSEQUEN MsgAlert("Pedido não encontrado !") ENDIF SET SOFTSEEK OFF ENDIF ENDCASE DbSelectArea("ARQPEDC") SET RELATION TO PEDCLI INTO ARQCLI oLbx:Refresh() oDlg:SetFocus() RETURN ***************************************************************************** STATIC FUNCTION CALC_UNIT( PUNIT,JUROS) PUNIT := STR( PUNIT * (1+(&cARQPEDC->PEDACRFIN/100)),10,2 ) RETURN( VAL(PUNIT) ) ***************************************************************************** STATIC FUNCTION ImprimeCupomRede(oLbxr,oDlgr) LOCAL nQTDREG IF lIMPREDE MsgAlert("Você já está em mode de impressão de cupons da rede !"+CRLF+; "Para finalizar pressione a tecla ESC e alguarde alguns"+CRLF+; "segundo.") RETURN Nil ENDIF MsgInfo("Para iniciar click em OK."+CRLF+; "Para finalizar pressione a tecla ESC." ) lIMPREDE := .T. PRIVATE cYESNO := "N",lPRESSESC ARQPEDC->( DbSetOrder(0) ) WHILE .T. lPRESSESC := .F. //bAction := { | oMeter, oText, oDlg, lEnd | Contador(oMeter, oText, oDlg, @lEnd ) } //MsgMeter( bAction ,"Aguardando cupons..." ) //Contador() SysWait(5) // msginfo("LASTKEY() "+STR(LASTKEY()) ) IF LASTKEY() = 27 lPRESSESC := .T. __Keyboard( "Finalizando emissão cupom rede" ) ENDIF IF lPRESSESC lPRESSESC := .F. IF MsgYesNo("Deseja finalizar programa de aguardo cupons ?",'Confirmação') EXIT ENDIF ELSE nQTDREG := 0 DbSelectArea("ARQPEDC") DbGoBottom() WHILE nQTDREG <= 100 .AND. !BOF() //? STR(PEDORC,6)+" "+PEDSIT ++ nQTDREG IF PEDSIT == "ICF" .AND. PEDGPED = "S" IF ASCAN(aPEDIDOS,ARQPEDC->PEDORC ) = 0 nCOMANDA := ARQPEDC->PEDORC cCNPJ_CPF:= IF( !EMPTY(ARQPEDC->PEDSTRECE),TRIM(ARQPEDC->PEDSTRECE),SPACE(18) ) cFPAGTO := IF(ARQPEDC->PEDTVEN = 1,"Dinheiro","Cartao") cNOMCLI := LEFT(ARQPEDC->PEDNCLI,30) // em teste EM 23/04/2015 ImprimeCupom() ENDIF ENDIF DbSkip(-1) ENDDO //IF !"FERRO" $ ARQPARAM->PEMPRESA // EXIT //ENDIF ENDIF ENDDO ARQPEDC->( DbSetOrder(4) ) //oLbxr:Refresh() //oDlgr:SetFocus() lIMPREDE := .F. RETURN Nil ***************************************************************************** STATIC FUNCTION ImprimeCupom() LOCAL nQTDITEM := nVALORC:= VICMS := 0,lCUPOMOK := .T. LOCAL cCDPROD,cTIPOQTD,cQtde,VSTRVALOR,cAliquota ARQPLC->( DBSEEK(ARQPEDC->PEDTVEN) ) DbSelectArea("ARQPEDD") SET RELATION TO PEDPROD INTO ARQPROD cCAMPQTDE := "PEDQTDE" SEEK STR(ARQPEDC->PEDORC,6)+ARQPEDC->PEDDORC WHILE PEDORC = ARQPEDC->PEDORC .AND. PEDDORC == ARQPEDC->PEDDORC .AND. !EOF() IF !EMPTY(&cCAMPQTDE) IF &cCAMPQTDE > 9999.999 MsgAlert("O Produto "+TRIM(PEDPROD)+CRLF+; "está com quantidade maior que 9999.999"+CRLF+; "Por favor, divida em quantidades menores ou iguais a 9999.999.") lCUPOMOK := .F. ENDIF ENDIF IF EMPTY(ARQPROD->ESTCLASS) MsgAlert("O Produto "+TRIM(PEDPROD)+CRLF+; "está com o NCM em branco !"+CRLF+; "Este cupom não será impresso !") lCUPOMOK := .F. ENDIF // DbSkip() ENDDO IF !lCUPOMOK SET RELATION TO RETURN Nil ENDIF // SEEK STR(ARQPEDC->PEDORC,6)+ARQPEDC->PEDDORC WHILE PEDORC = ARQPEDC->PEDORC .AND. PEDDORC = ARQPEDC->PEDDORC .AND. !EOF() IF PEDQTDE <= 0.01 DbSkip() LOOP ENDIF ++ nQTDITEM IF nQTDITEM=1 // // Abre o cupom fiscal // IF cECF == "DARUMA" // ELSEIF cECF == "DARUMAFW" IF EMPTY(cCNPJ_CPF) cCNPJ_CPF := " " ENDIF //? "executando aCFAbrir_SAT_Daruma "+ cCNPJ_CPF+ " - " + TRIM(cNOMCLI) +" - RUA TESTE, 129" nRETORNO := abrecupom_Daruma( TRIM(cCNPJ_CPF),TRIM(cNOMCLI),"RUA...") // aCFAbrir_SAT_Daruma // // ? "executando aCFAbrir_SAT_Daruma" // // nRETORNO := abrecupomPadrao_Daruma() // aCFAbrir_SAT_Daruma //ENDIF cMSGCAN := " " DO CASE CASE nRETORNO = 0 cMSGCAN := ": Erro genérico" CASE nRETORNO = 1 //MsgInfo("1: Abertura do cupom executada com sucesso") AADD(aPEDIDOS,ARQPEDC->PEDORC ) CASE nRETORNO = -52 cMSGCAN := "-52: Erro ao gravar em arquivo temporário." CASE nRETORNO = -99 cMSGCAN := "-99: Parâmetro inválido ou ponteiro nulo de parâmetro" CASE nRETORNO = -120 cMSGCAN := "-120: Encontrada tag inválida" CASE nRETORNO = -121 cMSGCAN := "-121: Estrutura Invalida" CASE nRETORNO = -122 cMSGCAN := "-122: Tag obrigatória não foi informada" CASE nRETORNO = -123 cMSGCAN := "-123: Tag obrigatória não tem valor preenchido" CASE nRETORNO = -130 cMSGCAN := "-130: CFe já Aberto" OTHERWISE cMSGCAN := STR(nRETORNO,5)+ ": Número de erro não identificado " ENDCASE IF !EMPTY(cMSGCAN) MsgAlert(cMSGCAN) RETURN Nil ENDIF ENDIF ENDIF // cCDPROD := TRIM(ARQPEDD->PEDPROD) cNOMPROD := TRIM(ARQPROD->ESTPROD) nPUNIT := CHKDESC( PEDVAL,ARQPEDC->PEDDESC ) nQTDVEN := ARQPEDD->PEDQTDE // IF cECF == "DARUMAFW" // DarumaFramework.dll VARAUX1 := STR(nQTDVEN,7,2) // 0002.00 IF SUBSTR(VARAUX1,6) = "00" // quantidade inteira cQtde := LTRIM( LEFT(VARAUX1,4) ) ELSE cQtde := LTRIM( TRANSF( nQTDVEN,"@E 99999.99") ) // 15,50 ENDIF cPUNIT := LTRIM( TRANSF( nPUNIT,"@E 99999.99") ) ELSE cQtde := STRZERO(nQTDVEN,7,2) // 0002.00 IF SUBSTR(cQTDE,6) = "00" // quantidade inteira cQtde := LEFT(cQtde,4) // 00004 cTIPOQTD := "I" ELSE cQtde := STR( nQTDVEN,8,3 ) // quantidade fracionada " 1.440" cTIPOQTD := "F" // 12345678 ENDIF /* VSTRVALOR := STR(nPUNIT,12,3) IF RIGHT(VSTRVALOR,1) = "0" // Preço unit rio com 2 casas decimais */ cPUNIT := STR(nPUNIT,10,2) nDECIMAIS := 2 /* ELSE // Preço unit rio com 3 casas decimais cPUNIT := Str( nPUNIT,10, 3 ) nDECIMAIS := 3 ENDIF */ ENDIF nTOTITEM := STR(nQTDVEN * nPUNIT,10,2) nVALORC += VAL(nTOTITEM) cCFOP := "5102" cNCM := TRIM(ARQPROD->ESTCLASS) //IF ARQPROD->ESTSTRIB = 'S' // Sub-Tributado //IF PEDSTRIB == "010" .AND. PEDPSTRIB > 0.00 // Subst. tributaria IF ARQPROD->ESTICMS = 0 IF ARQPROD->ESTCTRIB $ "060-500" cAliquota := "FF" cCFOP := "5405" ELSE cAliquota := "II" ENDIF ELSE cAliquota := STRZERO(ARQPROD->ESTICMS,5,2) // "18,00" ENDIF // // 'Vende item' // IF cECF == "BEMATEC" //IF !GrvCmdFis(11,{cCDPROD,LEFT(cNOMPROD,29),cAliquota,cTIPOQTD,cQTDE,nDECIMAIS,cPUNIT,"%","0000"},; // 0,NIL,NIL,.T.) // RETURN Nil //ENDIF ELSEIF cECF == "DARUMAFW" // DarumaFramework.dll // cALIQPIS := / 100 //nRetorno := ConfiguraImposto('PISAliq','01;;0,0065;') //? nRetorno //nRetorno := ConfiguraImposto('COFINSALIQ','01;;0,0065;') /* MsgInfo("Executando vende item - aCFVenderc_SAT_Daruma"+CRLF+; "Aliquota "+cAliquota+CRLF+; "Qtde "+cQtde+CRLF+; "Preço Unit "+cPUNIT+CRLF+; "D$ "+"D$"+CRLF+; "Valor Desc "+"0,00"+CRLF+; "Cod.Prod "+cCDPROD+CRLF+; "NCM "+ARQPROD->ESTCLASS+CRLF+; "Cfop "+cCFOP+CRLF+; "Un "+ARQPROD->ESTUNID+CRLF+; "Desc.Produto "+cNOMPROD ) */ // Exemplos importante sobre cfop: // http://www.contabeis.com.br/forum/topicos/26175/cfop-5102-ou-5405/ // http://tsdn.tecnospeed.com.br/cfop/post/cfop-5405-venda-de-mercadoria-adquirida-ou-recebida-de-terceiros-sujeita-ao-regime-de-substituicao-tributaria-na-condicao-de-contribuinte-substituido-tributacao-normal/p/8 iRetorno := aCFVenderC_SAT_Daruma(cAliquota,; cQtde,; cPUNIT,; "D$",; "0,00",; cCDPROD,; cNCM,; cCFOP,; ARQPROD->ESTUNID,; cNOMPROD, " ") //IF !iRETORNO == 1 // ? "Resposta vende item - aCFVender_SAT_Daruma" // ? iRetorno //ENDIF /* Sobre impostos http://www.desenvolvedoresdaruma.com.br/home/downloads/Site_2011/Help/DarumaFrameworkHelpOnline/DarumaFramework/SAT/Metodos_de_Emissao/aCFConfImposto_SAT_Daruma.htm */ ENDIF DbSkip() ENDDO // cFPAGTO := 'Dinheiro' cMSGCUPOM := 'Obrigado! Volte sempre.' IF !EMPTY(ARQPARAM->TOTIMPOS) // .AND. !EMPTY(nVLICMSS) cMSGCUPOM += "Total de impostos incidentes sobre essa nota"+CRLF+; "(Lei 12741/2012) alíquota de "+; LTRIM(STR(ARQPARAM->TOTIMPOS,5,2 )) +"% R$ "+; LTRIM( TRANSF( nVALORC * ARQPARAM->TOTIMPOS / 100,"@E 999,999.99") ) ENDIF // cVALORC := STR(nVALORC - ARQPEDC->PEDVDESC,13,3) // // Fecha cupom // IF cECF == "BEMATEC" //IF !GrvCmdFis(13,{cFPAGTO,'D',"$",STR(ARQPEDC->PEDVDESC,9,2),LEFT(cVALORC,12),cMSGCUPOM},; // 0,NIL,NIL,.T.) // RETURN Nil //ENDIF ELSEIF cECF == "DARUMAFW" // DarumaFramework.dll // ? 'Executando Totaliza_Cupom_daruma("D$","0000000.00") => aCFTotalizar_SAT_Daruma' Totaliza_Cupom_daruma("D$","0000000.00" ) // aCFeTotalizar_SAT_Daruma() /* O método aCFeEfetuarPagamento_SAT_Daruma possui apenas 1 parâmetro string, que recebe os dados de pagamento, identificados pelas respectivas tags. Os meios de pagamento devem ser aqueles definidos no SAT, portanto aqui, diferente da impressora fiscal, você deve seguir a ordem de cadastro do SAT, que está na tabela das tags aceitas pelo método, mais abaixo. iRetorno := aCFeEfetuarPagamento_SAT_Daruma("<MP><cMP>01</cMP><vMP>2500</vMP></MP>") iRetorno := aCFeEfetuarPagamento_SAT_Daruma("<MP><cMP>01</cMP><vMP>"+ STR(nVALORC,12,2) + "</vMP></MP>") // iRetorno := tCFeEncerrar_SAT_Daruma _SAT_Daruma("<infAdic><infCpl>Obrigado e volte sempre!</infCpl></infAdic>") */ // ? 'Executando FormaPag_Cupom_daruma(cFPAGTO,STR(nVALORC,12,2),"") => aCFEfetuarPagamento_SAT_Daruma' cVALORC := LTRIM( STR(nVALORC,12,2) ) FormaPag_Cupom_daruma(cFPAGTO,cVALORC,"") nRETORNO := Encerra_Daruma("0","Obrigado e volte sempre!!") IF !nRETORNO == 1 ? nRETORNO cMsgErro := SPACE(50) nRETORNO := AvisoErroSat( TRIM(cMsgErro),cMsgErro) ? nRETORNO ? cMsgErro ELSE // ? "encerramento ok" /* Método tCFEncerrar_SAT_Daruma que encerra o Cupom Fiscal eletrônico e faz envio do cupom para o SAT, além disso, aguarda um Ok do SAT e envia uma impressão para a Mini Impressora Daruma, do comprovante do Cupom Fiscal Eletrônico. 1: Comando executado com sucesso */ Str_Info := SPACE(50) nRETORNO := InfoEstendida_SAT_Daruma("4",Str_Info) // cNUMEXTRA := SPACE(6) nRETORNO := InfoEstendida_SAT_Daruma("1",cNUMEXTRA) /* Possíveis retornos do método: 0: Erro genérico 1: Comando executado com sucesso -99: Parâmetro inválido -136: CFe em estado inválido para operação */ // ? "nRETORNO rInfoEstendida_SAT_Daruma " // ? nRETORNO // ? Str_Info DbSelectArea("ARQPEDC") IF ARQPEDC->PEDORC = nCOMANDA .AND. !EMPTY(Str_Info) IF REGLOCK(20,.F.) REPLACE PEDSIT WITH "ECF",PEDCHVACES WITH Str_Info,PEDPROTOC WITH cNUMEXTRA DbUnlock() ENDIF ENDIF ENDIF ENDIF RETURN Nil ***************************************************************************** Mas Kapiaba. Isso só aconteceu em dois clientes...em um trocou o cabo usb do sat que liga ao micro e blz, no outro cheguei a colocar num computador novinho hp, com windows 10 e o problema as vezes aparece.
×
×
  • Create New...