giovanyvecchi

Estou disponibilizando os meus fontes para usar em conjunto com o acbrbfemonitor.exe estes procedimentos Baixem o arquivo no link abaixo. Nào tive tempo para gerar um exemplo, mais vai o prg meu com a rotina de buscar, manifestar, e efetuar o download do xml. Tem que usar minha classe acbrnfemonitor para funcionar ta tudo la. qualquer duvida postem aqui. https://www.sendspace.com/file/sc28nl

Acredito que muitos não usam ADS simplesmente por causa da falta de exemplos e tutorias. Eu uso ADS com SQL no estilo OOP, orientado ao objeto. Misturo tudo, tenho rotinas antigas estilo dbf e rotinas novas com scripts SQL avançado. Mais digo e confesso que não é facil entender o funcionamento de ADS por ele proporcionar uma variedade enorme de maneiras que voce pode fazer para obter o mesmo resultado. Para isto fiz o tAds. Tenho sistemas que acessam varios pontos ao mesmo tempo, coisa de doido mesmo e creio que devo saber uns 30% de Ads. Baixe o tortoise, instale no seu micro e baixe o tAds para ver se da pra entender. https://tads-class-for-harbour.googlecode.com/svn/trunk

Para os acentos e caracteres especiais usem a função HTML_TO_ANSI(), Da bliblioteca HbTip.lib de harbour FUNCTION HTML_TO_ANSI(f_cTxt) Local iFor := 0, cRetTxt := "" cRetTxt := HtmlToAnsi(f_cTxt) // Entity Name // HTML Reserved Characters For iFor := 34 to 62 cRetTxt := StrTran(cRetTxt,""+Alltrim(Str(iFor))+";",Chr(iFor)) Next // ISO 8859-1 Characters For iFor := 192 to 255 cRetTxt := StrTran(cRetTxt,""+Alltrim(Str(iFor))+";",Chr(iFor)) Next // ISO 8859-1 Symbols For iFor := 160 to 247 cRetTxt := StrTran(cRetTxt,""+Alltrim(Str(iFor))+";",Chr(iFor)) Next RETURN cRetTxt

Oi Desculpa ai, não tinha visto a postagem. Quando o programa usa o sistema Webbrowser do windows há algumas configurações que voce pode efetuar para regular o modo de compatibilidade com o Navegador. Use a Função SET_EXE_WEBBROWSER(f_cNameProg,f_nVersaoNavegador) Ex: SET_EXE_WEBBROWSER("GOOGLE.EXE",10) #define HKEY_LOCAL_MACHINE 2147483650 FUNCTION SET_EXE_WEBBROWSER(f_cNameProg,f_nVersaoNavegador) Local nFlagIE := 0 Default f_nVersaoNavegador := 8 // Compativel com Ie 8 If f_nVersaoNavegador == 7 nFlagIE := 7001 ElseIf f_nVersaoNavegador == 8 nFlagIE := 8888 ElseIf f_nVersaoNavegador == 9 nFlagIE := 9999 ElseIf f_nVersaoNavegador == 10 nFlagIE := 10001 ElseIf f_nVersaoNavegador == 11 nFlagIE := 11001 EndIf if HB_OSIS64BIT() oRegKey := TReg32():New( HKEY_LOCAL_MACHINE,; "SOFTWARE\Wow6432Node\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION" ) oRegKey:Set(f_cNameProg,nFlagIE,4) oRegKey:Close() oRegKey := TReg32():New( HKEY_LOCAL_MACHINE,; "SOFTWARE\Wow6432Node\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_ENABLE_WEB_CONTROL_VISUALS" ) oRegKey:Set(f_cNameProg,1,4) oRegKey:Close() oRegKey := TReg32():New( HKEY_LOCAL_MACHINE,; "SOFTWARE\Wow6432Node\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_TABBED_BROWSING" ) oRegKey:Set(f_cNameProg,1,4) oRegKey:Close() Else oRegKey := TReg32():New( HKEY_LOCAL_MACHINE,; "SOFTWARE\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_BROWSER_EMULATION" ) oRegKey:Set(f_cNameProg,nFlagIE,4) oRegKey:Close() oRegKey := TReg32():New( HKEY_LOCAL_MACHINE,; "SOFTWARE\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_ENABLE_WEB_CONTROL_VISUALS" ) oRegKey:Set(f_cNameProg,1,4) oRegKey:Close() oRegKey := TReg32():New( HKEY_LOCAL_MACHINE,; "SOFTWARE\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_TABBED_BROWSING" ) oRegKey:Set(f_cNameProg,1,4) oRegKey:Close() EndIf Return Nil

Uso uma classe. Os envios são por xmls #include "Fivewin.ch" #Include "TsSay.ch" FUNCTION ACBR_NFE_IMPRIMIR(f_cFileXmlName) Local oAcbrNfeMonitor, lImprimido := .F. oAcbrNfeMonitor := AcbrNFeMonitor():New() lImprimido := oAcbrNfeMonitor:AcbrNfe_ImprimirDanfe(f_cFileXmlName) oAcbrNfeMonitor:End() RETURN lImprimido /// CONFIG_TERMINAL_VARS_UPDATE() /// https://homologacao.nfe.fazenda.sp.gov.br/nfeweb/services/NfeStatusServico2.asmx /// https://nfe.sefaz.sp.gov.br/nfe/services/NfeStatusServico Class AcbrNFeMonitor Data oDb_Semaforo Data cComando Data cCaminhoAcbrLocal, cCaminhoAcbrRede, cCaminhoAcbrFound Data cCaminhoAcbrXmlConfigEnvioResposta Data cCaminhoAcbrConfigComandos, cCaminhoAcbrXmlConfigNormal, cCaminhoAcbrXmlConfigCancelado Data cCaminhoAcbrXmlConfigInutilizados, cCaminhoAcbrXmlConfigPdf Data nHandleFileEntrada, nHandleFileretorno Data cSefazEnvio_TpAmb, cSefazEnvio_CStat, cSefazEnvio_XMotivo, cSefazEnvio_Data, cSefazEnvio_Horas Data cSefazRetorno_NRec, cSefazRetorno_TpAmb, cSefazRetorno_CStat, cSefazRetorno_XMotivo Data cSefazNFeProtocolo, cSefazDigitoValor Data aNFesManifesto, cUltimoNSU Data aPrintersInstalados, cPrinterDefault Data lRetornoOk, cRetornoTxt Method New() Constructor Method End() Method AcbrNFe_ConsultarNFe(f_cFileXmlName) Method AcbrNFe_ConsultaNFeDest(f_cCnpj,f_cUltNSU) Method AcbrNFe_ManifestoDestinatario(f_cCnpj,f_cDanfeChave) Method AcbrNFe_EnviaComando() method AcbrNFe_EsperaResposta() Method AcbrNFe_StatusServico() Method AcbrNFe_Validar(f_cFileXmlName) Method AcbrNFe_Assinar(f_cFileXmlName) Method AcbrNFe_Transmitir(f_cFileXmlName) Method AcbrNfe_Cancelar(f_cChaveDanfe,f_cJustificativa,f_cCnpj) Method AcbrNfe_ImprimirDanfe(f_cFileXmlName) Method AcbrNFe_ImprimirDanfePdf(f_cFileXmlName) Method AcbrNfe_ImprimirEvento(f_cFileXmlEvento,f_cFileXmlNFe) Method AcbrNfe_ImprimirEventoPdf(f_cFileXmlEvento) Method AcbrNFe_DownLoadNFe(f_cCnpj,f_cChave) EndClass //----------------------------------------------------------------------------- Method New() class AcbrNFeMonitor Local cFileIniAcbr := "", cTmp := "", cFileIniPrinters := "", nCountPrn := 0, iFor := 0 ::cCaminhoAcbrConfigComandos := "C:\ACBrNFeMonitor" ::cCaminhoAcbrFound := "" ::cRetornoTxt := "" ::lRetornoOk := .F. ::aNFesManifesto := {} ::cUltimoNSU := "0" ::oDb_Semaforo := SEMAFORO_DB():New() ::oDb_Semaforo:GoTo(1471) ::cCaminhoAcbrLocal := AllTrim(::oDb_Semaforo:VarGet("FLAG_ATUAL")) ::oDb_Semaforo:GoTo(1472) ::cCaminhoAcbrRede := AllTrim(::oDb_Semaforo:VarGet("FLAG_ATUAL")) If File(::cCaminhoAcbrLocal+"\ACBrNFeMonitor.exe") ::cCaminhoAcbrFound := ::cCaminhoAcbrLocal elseif File(::cCaminhoAcbrRede+"\ACBrNFeMonitor.exe") ::cCaminhoAcbrFound := ::cCaminhoAcbrRede EndIf ::aPrintersInstalados := {} If !Empty(::cCaminhoAcbrFound) cFileIniAcbr := ::cCaminhoAcbrFound + "\ACBrNFeMonitor.ini" cTmp := ALLTRIM(GetPvProfString( "DANFE", "DecimaisValor","0", cFileIniAcbr )) If cTmp != "3" WritePProString("DANFE", "DecimaisValor","3", cFileIniAcbr ) EndIf WritePProString("ACBrNFeMonitor", "Intervalo","800", cFileIniAcbr ) ::cCaminhoAcbrXmlConfigEnvioResposta := ALLTRIM(GetPvProfString( "Geral", "PathSalvar","", cFileIniAcbr )) ::cCaminhoAcbrXmlConfigPdf := ALLTRIM(GetPvProfString( "DANFE", "PathPDF","", cFileIniAcbr )) ::cCaminhoAcbrXmlConfigNormal := ALLTRIM(GetPvProfString( "Arquivos", "PathNFe","", cFileIniAcbr )) ::cCaminhoAcbrXmlConfigCancelado := ALLTRIM(GetPvProfString( "Arquivos", "PathCan","", cFileIniAcbr )) ::cCaminhoAcbrXmlConfigInutilizados := ALLTRIM(GetPvProfString( "Arquivos", "PathInu","", cFileIniAcbr )) cFileIniPrinters := ::cCaminhoAcbrFound+"\PrinterGerente.ini" ///msginfo(cFileIniPrinters) ::aPrintersInstalados := {} Do While .T. nCountPrn ++ cTmp := GetPvProfString( "PRINTERS", "PRN_"+StrZero(nCountPrn,2),"", cFileIniPrinters ) ///msginfo(cTmp) If !Empty(cTmp) aadd(::aPrintersInstalados,cTmp) Else Exit EndIf EndDo EndIf ///msgarray(::aPrintersInstalados) ::cSefazEnvio_TpAmb := "" ::cSefazEnvio_CStat := "" ::cSefazEnvio_XMotivo := "" ::cSefazEnvio_Data := Date() ::cSefazEnvio_Horas := "" ::cSefazRetorno_NRec := "" ::cSefazRetorno_TpAmb := "" ::cSefazRetorno_CStat := "" ::cSefazRetorno_XMotivo := "" ::cSefazNFeProtocolo := "" ::cSefazDigitoValor := "" Return Self //----------------------------------------------------------------------------- Method End() class AcbrNFeMonitor ::oDb_Semaforo:End() Return Self //----------------------------------------------------------------------------- Method AcbrNFe_ConsultarNFe(f_cDanfeChave) class AcbrNFeMonitor Loca cFileXmlImprimir := "", nTmp := 0, lRetTmp := .F. ::cComando := "" ::lRetornoOk := .F. ::cRetornoTxt := "" ::cComando := "NFE.ConsultarNFe('"+f_cDanfeChave+"')" ::cComando := STRTRAN(::cComando,"'",CHR(34)) lRetTmp := ::AcbrNFe_EnviaComando() If lRetTmp hb_idleSleep(2) lRetTmp := ::AcbrNFe_EsperaResposta() Endif Return lRetTmp //----------------------------------------------------------------------------- Method AcbrNFe_ConsultaNFeDest(f_cCnpj,f_cUltNSU,f_oList) class AcbrNFeMonitor Local cFileXmlImprimir := "", nTmp := 0, lRetTmp := .F. Local cTmpManifesto := Dir_Temp()+"NFeManifesto.txt" Local iFor := 0 Local cIndCont := "", cCabecalho := "", cNSU := "", aTmp := {}, cTmp := "", cChaves := "" Default f_cUltNSU := "0" ::aNFesManifesto := {} ::cComando := "" ::lRetornoOk := .F. ::cRetornoTxt := "" //::cComando := "NFE.ConsultaNFeDest('"+f_cCnpj+"',1,0,"+AllTrim(Str(f_cUltNSU))+")" Do While .T. nTmp ++ ::cComando := "NFE.ConsultaNFeDest("+f_cCnpj+",1,0,"+AllTrim(f_cUltNSU)+")" ::cComando := STRTRAN(::cComando,"'",CHR(34)) lRetTmp := ::AcbrNFe_EnviaComando() If lRetTmp hb_idleSleep(.5) lRetTmp := ::AcbrNFe_EsperaResposta() Else Exit Endif If at("ERRO",::cRetornoTxt) > 0 .or. !lRetTmp Exit EndIf MemoWrit(cTmpManifesto,"[INICIAL]"+CRLF+::cRetornoTxt) ///MemoWrit(Dir_Temp()+"TxtMan"+StrZero(nTmp,3)+".txt",::cRetornoTxt) f_cUltNSU := GetPvProfString( "INICIAL", "ultNSU","0", cTmpManifesto ) ::cUltimoNSU := f_cUltNSU For Ifor := 1 To 100 cCabecalho := "RESNFE"+StrZero(iFor,3) IF At(cCabecalho,::cRetornoTxt) == 0 Exit EndIf cNSU := GetPvProfString( cCabecalho, "NSU","0", cTmpManifesto ) If cNSU != "0" aTmp := Array(20) aTmp[01] := cNSU aTmp[02] := GetPvProfString( cCabecalho, "chNFe","0", cTmpManifesto ) aTmp[03] := GetPvProfString( cCabecalho, "CNPJ","0", cTmpManifesto ) aTmp[04] := Upper(GetPvProfString( cCabecalho, "xNome","0", cTmpManifesto )) aTmp[05] := GetPvProfString( cCabecalho, "IE","0", cTmpManifesto ) aTmp[06] := cTod(GetPvProfString( cCabecalho, "dEmi","0", cTmpManifesto )) aTmp[07] := Val(GetPvProfString( cCabecalho, "tpNF","0", cTmpManifesto )) aTmp[08] := Val(StrTran(GetPvProfString( cCabecalho, "vNF","0", cTmpManifesto ),",",".")) aTmp[09] := GetPvProfString( cCabecalho, "digVal","0", cTmpManifesto ) aTmp[10] := GetPvProfString( cCabecalho, "dhRecbto","0", cTmpManifesto ) aTmp[11] := GetPvProfString( cCabecalho, "cSitNFe","0", cTmpManifesto ) aTmp[12] := GetPvProfString( cCabecalho, "cSitConf","0", cTmpManifesto ) aTmp[19] := cTod(SubStr(aTmp[10],1,10)) aTmp[20] := SubStr(aTmp[10],12) aadd(::aNFesManifesto,aTmp) cChaves += aTmp[2]+CRLF If !Hb_IsNil(f_oList) f_oList:Add(dToc(aTmp[06])+" - "+aTmp[04]) f_oList:GoBottom() f_oList:Refresh() SysRefresh() cursorwait() EndIf EndIf Next cIndCont := GetPvProfString( "INICIAL", "indCont","2", cTmpManifesto ) If cIndCont == "0" Exit EndIf EndDo //MemoWrit(Dir_Temp()+"Chaves.txt",cChaves) //xbrowse(::aNFesManifesto) ///::AcbrNFe_DownLoadNFe(f_cCnpj,aTmp[2]) Return lRetTmp //----------------------------------------------------------------------------- Method AcbrNFe_ManifestoDestinatario(f_cCnpj,f_cDanfeChave) Class AcbrNFeMonitor Local nConclusao := 0, lRetTmp := .F. Local cDataNow := dToc(date())+" "+ Time() // Local cDataNow := SubStr(dToc(date()),1,6)+SubStr(AllTrim(str(Year(Date()))),3)+ " " + Time() ::cComando := "NFe.EnviarEvento('" //+CRLF ::cComando += "[Evento]"+CRLF ::cComando += "idLote=2"+CRLF ::cComando += "[Evento001]"+CRLF ::cComando += "chNFe="+f_cDanfeChave+CRLF ::cComando += "cOrgao=91"+CRLF ::cComando += "CNPJ="+f_cCnpj+CRLF ::cComando += "dhEvento="+cDataNow+CRLF ::cComando += "tpEvento=210200"+CRLF ::cComando += "nSeqEvento=1"+CRLF ::cComando += "versaoEvento=1.00"+CRLF ::cComando += "descEvento=CONFIRMACAO DA OPERACAO"+CRLF ::cComando += "xCorrecao="+CRLF ::cComando += "xCondUso="+CRLF ::cComando += "nProt="+CRLF ::cComando += "xJust=')" ::cComando := STRTRAN(::cComando,"'",CHR(34)) lRetTmp := ::AcbrNFe_EnviaComando() If lRetTmp hb_idleSleep(.5) lRetTmp := ::AcbrNFe_EsperaResposta() Endif If !lRetTmp nConclusao := -1 // Acbr não responde Else If at("ERRO",::cRetornoTxt) > 0 nConclusao := 1 // Não foi processado ElseIf at("REJEICAO",Upper(::cRetornoTxt)) > 0 .or. at("REJEIÇÃO",Upper(::cRetornoTxt)) > 0 nConclusao := 2 // Rejeitado EndIf EndIf Return nConclusao //----------------------------------------------------------------------------- Method AcbrNFe_Validar(f_cFileXml) class AcbrNFeMonitor Loca cFileXmlCopy := "", nTmp := 0, lRetTmp := .F. ::cComando := "" ::lRetornoOk := .F. ::cRetornoTxt := "" If !File(f_cFileXml) ::lRetornoOk := .F. ::cRetornoTxt := "Erro: Arquivo Xml não encontrado ou não foi gerado." Return ::lRetornoOk EndIf nTmp := RAT("\", f_cFileXml) cFileXmlCopy := ::cCaminhoAcbrXmlConfigNormal + SubStr(f_cFileXml,nTmp) lMkDir(::cCaminhoAcbrXmlConfigNormal) Copy file (f_cFileXml) to (cFileXmlCopy) ::cComando := "NFE.ValidarNFe('"+cFileXmlCopy+"')" ::cComando := STRTRAN(::cComando,"'",CHR(34)) lRetTmp := ::AcbrNFe_EnviaComando() If lRetTmp hb_idleSleep(2) lRetTmp := ::AcbrNFe_EsperaResposta() Endif Return lRetTmp //----------------------------------------------------------------------------- Method AcbrNFe_Assinar(f_cFileXmlName) class AcbrNFeMonitor Loca cFileXmlAssinar := "", nTmp := 0, lRetTmp := .F. ::cComando := "" ::lRetornoOk := .F. ::cRetornoTxt := "" cFileXmlAssinar := ::cCaminhoAcbrXmlConfigNormal + "\" + Alltrim(f_cFileXmlName) If !File(cFileXmlAssinar) ::lRetornoOk := .F. ::cRetornoTxt := "Erro: Arquivo Xml não encontrado ou não foi gerado." Return ::lRetornoOk EndIf ////Copy file (f_cFileXml) to (cFileXmlAssinar) ::cComando := "NFE.AssinarNFe('"+cFileXmlAssinar+"')" ::cComando := STRTRAN(::cComando,"'",CHR(34)) lRetTmp := ::AcbrNFe_EnviaComando() If lRetTmp hb_idleSleep(2) lRetTmp := ::AcbrNFe_EsperaResposta() Endif Return lRetTmp //----------------------------------------------------------------------------- Method AcbrNFe_Transmitir(f_cFileXmlName,f_nNumeroNFe) class AcbrNFeMonitor Local cFileXmlTransmitir := "", nTmp := 0, cTmp := "", lRetTmp := .F., cFileSefazRetorno := "" Local cGrupoNFe := "" ::cComando := "" ::lRetornoOk := .F. ::cRetornoTxt := "" cGrupoNFe := "NFE"+M_Str(f_nNumeroNFe) cFileXmlTransmitir := ::cCaminhoAcbrXmlConfigNormal + "\" + Alltrim(f_cFileXmlName) If !File(cFileXmlTransmitir) ::lRetornoOk := .F. ::cRetornoTxt := "Erro: Arquivo Xml não encontrado ou não foi gerado." Return ::lRetornoOk EndIf ////Copy file (f_cFileXml) to (cFileXmlTransmitir) ::cComando := "NFE.EnviarNFe('"+cFileXmlTransmitir+"',0,0,0)" ::cComando := STRTRAN(::cComando,"'",CHR(34)) lRetTmp := ::AcbrNFe_EnviaComando() If lRetTmp hb_idleSleep(8) lRetTmp := ::AcbrNFe_EsperaResposta(50) Endif If !lRetTmp Return .F. EndIf cFileSefazRetorno := Dir_Temp()+"SefazRet.txt" fErase(cFileSefazRetorno) Memowrit(cFileSefazRetorno,::cRetornoTxt) ::cSefazEnvio_TpAmb := ALLTRIM(GetPvProfString( "ENVIO", "TpAmb","", cFileSefazRetorno )) ::cSefazEnvio_CStat := ALLTRIM(GetPvProfString( "ENVIO", "CStat","", cFileSefazRetorno )) ::cSefazEnvio_XMotivo := ALLTRIM(GetPvProfString( "ENVIO", "XMotivo","", cFileSefazRetorno )) cTmp := ALLTRIM(GetPvProfString( "ENVIO", "DhRecbto","", cFileSefazRetorno )) ::cSefazEnvio_Data := cTod(SubStr(cTmp,1,10)) ::cSefazEnvio_Horas := SubStr(cTmp,12) ::cSefazRetorno_NRec := ALLTRIM(GetPvProfString( "RETORNO", "NRec","", cFileSefazRetorno )) ::cSefazRetorno_TpAmb := ALLTRIM(GetPvProfString( "RETORNO", "TpAmb","", cFileSefazRetorno )) ::cSefazRetorno_CStat := ALLTRIM(GetPvProfString( "RETORNO", "CStat","", cFileSefazRetorno )) ::cSefazRetorno_XMotivo := ALLTRIM(GetPvProfString( "RETORNO", "XMotivo","", cFileSefazRetorno )) ::cSefazNFeProtocolo := ALLTRIM(GetPvProfString( cGrupoNFe, "NProt","", cFileSefazRetorno )) ::cSefazDigitoValor := ALLTRIM(GetPvProfString( cGrupoNFe, "DigVal","", cFileSefazRetorno )) If At("AUTORIZADO",UPPER(::cSefazRetorno_XMotivo)) == 0 lRetTmp := .F. EndIf Return lRetTmp //----------------------------------------------------------------------------- Method AcbrNfe_Cancelar(f_cChaveDanfe,f_cJustificativa,f_cCnpj) class AcbrNFeMonitor Loca lRetTmp := .F. ::cComando := "" ::lRetornoOk := .F. ::cRetornoTxt := "" ::cComando := "NFE.CancelarNFE('"+f_cChaveDanfe+"','"+f_cJustificativa+"',"+f_cCnpj+"')" ::cComando := STRTRAN(::cComando,"'",CHR(34)) lRetTmp := ::AcbrNFe_EnviaComando() If lRetTmp hb_idleSleep(5) lRetTmp := ::AcbrNFe_EsperaResposta() Endif Return lRetTmp //----------------------------------------------------------------------------- Method AcbrNfe_ImprimirDanfe(f_cFileXmlName,f_cPrinterName, f_nCopias) class AcbrNFeMonitor Local cFileXmlImprimir := "", nTmp := 0, lRetTmp := .F., iFor := 0 Default f_cPrinterName := "", f_nCopias := 1 ::cComando := "" ::lRetornoOk := .F. ::cRetornoTxt := "" If At("\",f_cFileXmlName) == 0 cFileXmlImprimir := ::cCaminhoAcbrXmlConfigNormal + "\" + Alltrim(f_cFileXmlName) Else cFileXmlImprimir := f_cFileXmlName EndIf If !File(cFileXmlImprimir) ::lRetornoOk := .F. ::cRetornoTxt := "Erro: Arquivo Xml não encontrado ou não foi gerado." Return ::lRetornoOk EndIf ////Copy file (f_cFileXml) to (cFileXmlImprimir) If Empty(f_cPrinterName) ::cComando := "NFE.ImprimirDanfe('"+cFileXmlImprimir+"')" Else ///::cComando := "NFE.AcbrNfe_ImprimirDanfe('"+cFileXmlImprimir+"','"+f_cPrinterName+"',"+M_Str(f_nCopias,0)+")" ::cComando := "NFE.ImprimirDanfe('"+cFileXmlImprimir+"','"+f_cPrinterName+"',1)" EndIf ::cComando := STRTRAN(::cComando,"'",CHR(34)) ///msginfo(::cComando) For iFor := 1 to f_nCopias lRetTmp := ::AcbrNFe_EnviaComando() If lRetTmp hb_idleSleep(5) lRetTmp := ::AcbrNFe_EsperaResposta() Endif Next ///If lRetTmp /// hb_idleSleep(5) /// lRetTmp := ::AcbrNFe_EsperaResposta() ///Endif Return lRetTmp //----------------------------------------------------------------------------- Method AcbrNFe_ImprimirDanfePdf(f_cFileXmlName) class AcbrNFeMonitor Local cFileXmlImprimir := "", nTmp := 0, lRetTmp := .F. ::cComando := "" ::lRetornoOk := .F. ::cRetornoTxt := "" ///If !File(cFileXmlImprimir) cFileXmlImprimir := ::cCaminhoAcbrXmlConfigNormal + "\" + Alltrim(f_cFileXmlName) If !File(cFileXmlImprimir) ::lRetornoOk := .F. ::cRetornoTxt := "Erro: Arquivo Xml não encontrado ou não foi gerado." Return ::lRetornoOk EndIf ////Copy file (f_cFileXml) to (cFileXmlImprimir) ::cComando := "NFE.ImprimirDanfePdf('"+cFileXmlImprimir+"')" ::cComando := STRTRAN(::cComando,"'",CHR(34)) lRetTmp := ::AcbrNFe_EnviaComando() If lRetTmp hb_idleSleep(5) lRetTmp := ::AcbrNFe_EsperaResposta() Endif Return lRetTmp //----------------------------------------------------------------------------- Method AcbrNfe_ImprimirEvento(f_cFileXmlEvento,f_cFileXmlNFe) class AcbrNFeMonitor Local lRetTmp := .F. ::cComando := "" ::lRetornoOk := .F. ::cRetornoTxt := "" If !File(f_cFileXmlEvento) ::lRetornoOk := .F. ::cRetornoTxt := "Erro: Arquivo Xml do evento não encontrado."+CRLF+ ; "Arquivo: "+f_cFileXmlEvento Return ::lRetornoOk EndIf ::cComando := "NFE.ImprimirEvento('"+f_cFileXmlEvento+"','"+f_cFileXmlNFe+"')" ::cComando := STRTRAN(::cComando,"'",CHR(34)) lRetTmp := ::AcbrNFe_EnviaComando() If lRetTmp hb_idleSleep(2) lRetTmp := ::AcbrNFe_EsperaResposta() Endif Return lRetTmp //----------------------------------------------------------------------------- Method AcbrNfe_ImprimirEventoPdf(f_cFileXmlEvento) class AcbrNFeMonitor Local lRetTmp := .F. ::cComando := "" ::lRetornoOk := .F. ::cRetornoTxt := "" If !File(f_cFileXmlEvento) ::lRetornoOk := .F. ::cRetornoTxt := "Erro: Arquivo Xml do evento não encontrado."+CRLF+ ; "Arquivo: "+f_cFileXmlEvento Return ::lRetornoOk EndIf ::cComando := "NFE.ImprimirEventoPdf('"+f_cFileXmlEvento+"')" ::cComando := STRTRAN(::cComando,"'",CHR(34)) lRetTmp := ::AcbrNFe_EnviaComando() If lRetTmp hb_idleSleep(2) lRetTmp := ::AcbrNFe_EsperaResposta() Endif Return lRetTmp //----------------------------------------------------------------------------- Method AcbrNFe_DownLoadNFe(f_cCnpj,f_cChave) class AcbrNFeMonitor Local cTxtNFe := "",lRetTmp := .F. ::cComando := "" ::lRetornoOk := .F. ::cRetornoTxt := "" // ::cComando := "DownloadNFE('"+f_cCnpj+"','"+f_cChave+"')" ::cComando := "DownloadNFE("+f_cCnpj+","+f_cChave+")" ::cComando := STRTRAN(::cComando,"'",CHR(34)) lRetTmp := ::AcbrNFe_EnviaComando() If lRetTmp hb_idleSleep(2) lRetTmp := ::AcbrNFe_EsperaResposta() Endif Return lRetTmp //----------------------------------------------------------------------------- Method AcbrNFe_EnviaComando() class AcbrNFeMonitor Local iFor := 0 ::lRetornoOk := .F. fErase(::cCaminhoAcbrFound+"\SAINFE.TXT") For iFor := 1 To 4 ::nHandleFileEntrada := Fcreate(::cCaminhoAcbrFound+"\ENTNFE.TXT") If ::nHandleFileEntrada == -1 SysWait(.3) Else Fwrite(::nHandleFileEntrada,::cComando) FClose(::nHandleFileEntrada) EndIf Next If ::nHandleFileEntrada == -1 ::lRetornoOk := .F. ::cRetornoTxt := "Erro: Não foi possivel criar o arquivo de entrada ENTNFE.TXT" Else ::lRetornoOk := .T. EndIf Return ::lRetornoOk //----------------------------------------------------------------------------- Method AcbrNFe_EsperaResposta(f_nSecondsEspera) class AcbrNFeMonitor Local lOpen := .F., nTentativa := 0, nEsperaResposta := 0 Default f_nSecondsEspera := 20 f_nSecondsEspera := (f_nSecondsEspera * 5) nEsperaResposta := f_nSecondsEspera * 2 ::cRetornoTxt := Space(32768) hb_idleSleep( .2 ) Do While .T. nTentativa ++ if File(::cCaminhoAcbrFound+"\SAINFE.TXT") ::nHandleFileEntrada := Fopen(::cCaminhoAcbrFound+"\SAINFE.TXT",16) If ::nHandleFileEntrada == -1 hb_idleSleep( 0.2 ) else lOpen := .T. Exit EndIf Else hb_idleSleep( 0.2 ) EndIf If nTentativa > nEsperaResposta If MsgNoYes("O AcbrNFeMonitor não esta respondendo ou esta inativo."+CRLF+CRLF+; "Deseja Abortar o procedimento.",; "Atenção, Responda.") Exit EndIf EndIf EndDo ::lRetornoOk := lOpen If lOpen Fread(::nHandleFileEntrada,@::cRetornoTxt,32768) ::cRetornoTxt := rTrim(::cRetornoTxt) Else If nTentativa > 80 ::cRetornoTxt := "Erro: O tempo de limite de espera do arquivo de retorno expirou" Else ::cRetornoTxt := "Erro: Não foi possivel abrir o arquivo de retorno SAINFE.TXT" Endif Endif If ::nHandleFileEntrada > 0 FClose(::nHandleFileEntrada) EndIf If At("ERRO",UPPER(::cRetornoTxt)) > 0 ::lRetornoOk := .F. EndIf Return ::lRetornoOk //----------------------------------------------------------------------------- Method AcbrNFe_StatusServico() class AcbrNFeMonitor Local lRetTmp := .F. ::cComando := "" ::lRetornoOk := .F. ::cRetornoTxt := "" ::cComando := "NFE.StatusServico" lRetTmp := ::AcbrNFe_EnviaComando() If lRetTmp lRetTmp := ::AcbrNFe_EsperaResposta() Endif Return lRetTmp //----------------------------------------------------------------------------- /////////////////////////////////////////////////////////////////////////////// FUNCTION Acbr_Nfe_Monitor_Config_Printers() Local oDb_SemaforoIni := SEMAFORO_DB():New() Local cPastaAcbr := "" Local aPrinters := {}, iFor := 0, cFileIni := "" oDb_SemaforoIni:GoTo(1471) cPastaAcbr := oDb_SemaforoIni:VarGetRtrim("FLAG_ATUAL") oDb_SemaforoIni:End() If !File(cPastaAcbr+"\ACBrNFeMonitor.exe") ///msginfo(cPastaAcbr+"\ACBrNFeMonitor.exe") Return Nil EndIf cFileIni := cPastaAcbr + "\PrinterGerente.ini" fErase(cFileIni) aPrinters := aGetPrinters() For Ifor := 1 To Len(aPrinters) WritePProString( "PRINTERS", "PRN_"+StrZero(iFor,2), aPrinters[ifor], cFileIni) Next Return nil

Execute assim WinExec("Teste.Bat",0)

Eu fiz a comunicação com os equipamentos da Companitec, só que não uso a dll, fiz as comunicações serial e rede (socket) na unha mesmo. Não sei se interessa a voce. No inicio a classe que criei era para a dll, depois acabou sendo pelos comandos de linha, string por string.

É por causa do Java Coloque esta linha depois do tActivex() oActiveX:Silent := .T.

Oi Ederson, o Ads não não é apenas uma solução temporaria e sim definitiva. Alem de voce poder trabalhar do mesmo modo mais com alguns ajustes voce vai adaptando para funcionamentos em SQL cliente/servidor. Trabalho com ads desde 2004, fiz inumeras ferramentas, mais o TADS supre todas as nescessidades. Baixe o TADS pelo Tortoise https://tads-class-for-harbour.googlecode.com/svn/trunk Olhe na pasta Sample para um pequeno exemplo. e na Pasta HelptAds para o Help de tAds Qualquer duvida adicione meu skype giovany.vecchi

O id é o primeiro parametro oTeste := TActiveX():Redefine( 120, oDlg )

Para entrar no mundo do Sql não é facil mesmo. Tenho varias rotinas usando o Velho ALIAS->CAMPO e rotinas novas usando Data Set de Ads. Hoje, muita instrução como triggers, store procedures, functions fica tudo no Dicionariode dados de Advantage, sem falar no tal de Ri Objects e AEPS (Advantage Extended Procedures) que é complicado pra burro. Mais aconselho o pessoal a estudar o Sql, que depois voce se interage na maioria dos bandos de dados Relacionais.

Eu uso o ComboEdit a anos, ja fiz algumas alterações nele e funciona bem. Se servir pra alguem, tai o exemplo e a função Redefine Combobox oCb771_Cidades var vCb771_Cidades ; items aCb771_Cidades id 771 of oDlgBairros ; PICTURE "@!" STYLE CBS_DROPDOWN oCb771_Cidades:oGet:bChange := ; {|nKey,nFlags,Self| ComboEdit( nKey,nFlags,Self,oCb771_Cidades,oDlgBairros)} /////////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////////////////////////// FUNCTION ComboEdit(f_nKey,f_nFlags,f_oGet,f_oCbx,f_oDlgCont) Local cBuffer := "", lInsert := .f., nPosGet := f_oGet:nPos Local nPos IF Set( _SET_INSERT ) lInsert := .t. ENDIF IF f_nKey == 13 f_oDlgCont:gonextCtrl(getfocus()) ENDIF IF f_nKey == 9 f_oDlgCont:goPrevCtrl(getfocus()) ENDIF IF f_nKey >= 48 .and. f_nKey <= 128 if f_oGet:lFocused cBuffer := Left(GetWindowText(f_oGet:hWnd), f_oGet:oGet:Pos -1) else Return nil endif nPos := f_oCbx:FindString(cBuffer,Len(cBuffer)) IF nPos > 0 f_oCbx:open() f_oCbx:Select(nPos) f_oGet:VarPut(f_oCbx:aItems[nPos]) f_oGet:oGet:UpDateBuffer() IF lInsert .and. nPos > 0 IF f_oGet:lfocused() f_oGet:oGet:Delete() f_oGet:oGet:UpDateBuffer() ENDIF ENDIF f_oGet:DispText() f_oGet:SetPos(nPosGet) ELSE f_oCbx:SendMsg(335, 0 ) f_oGet:VarPut(cBuffer+space(len(f_oGet:oGet:VarGet())-len(cBuffer))) f_oGet:oGet:UpDateBuffer() f_oGet:DispText() f_oGet:SetPos(nPosGet) ENDIF ENDIF Return Nil

Tente colocar estes parametros no Bcc32 -tWM -c -O2 -D__WIN__ -D__HARBOUR__ -DHB_API_MACROS -D__NODEBUG__

Mostra as linhas de compilação de Harbour.exe e Bcc32.exe

Mostra seu .Mak, ou Bat de compilação para gente dar uma olhada.

No exemplo que fiz acima, trocando o Dialog.prg vc chama a função uma vez só. Não precisa ficar ativando e desativando em todas as dialogs. Apenas no inicio do programa voce chama: SetAutoTransp(.T.,150) // Exemplo

Neste caso a dialog sempre vai estar transparent No meu exemplo ele fica tranparente somente quando esta fora de focus

Eu uso o cobrebem tambem e fiz uma classe, não da erro #Include "FiveWin.ch" FUNCTION BOLETO_TESTA() Local oCobreBemX oCobreBemX := BoletoCobreBemX():New(DIR_BOLETO()+"237-16.conf") oCobreBemX:BoletoCbxAdd() oCobreBemX:BoletoCbxImprimir() oCobreBemX:End() RETURN NIL Class BoletoCobreBemX Data oCobreBemX, oBoleto, lInicializaCobrebemX, cTxtArquivoLicensa, lGerarRemessa Data cArquivoRemessaNome Init "REMESSA.REM" Data cArquivoRemessaPasta Init "C:\" Data cArquivoRetorno Init "RETORNO.TXT" Data aRetornoOcorrencias Init {} Data nPaginaAtual Init 1 Data cNossoNumeroGerado Init "" Data cNomeCedente Init "CEDENTE DE TESTE" Data cCodigoAgencia Init "1234-5" Data cNumeroContaCorrente Init "00000123-X" Data cCodigoCedente Init "123456" Data cInicioNossoNumero Init "0000001" Data cFimNossoNumero Init "9999999" Data cProximoNossoNumero Init "41" Data cTiposDocumentosCobranca Init "RC" Data cNomeSacado Init "FULANO DE TAL SACADO" Data cNumeroDocumento Init "12345" Data cCPFSacado Init "111.111.11111" Data cEnderecoSacado Init "Rua de Teste" Data cBairroSacado Init "Bairro de Teste" Data cCidadeSacado Init "Cidade de Teste" Data cEstadoSacado Init "SÃO PAULO" Data cCepSacado Init "01001001" Data cDataVencimento Init "01/10/2002" Data nValorDocumento Init 123.45 Data nValorDesconto Init 0.00 Data cDemonstrativo Init "Demonstracao" Data cInstrucoesCaixa Init "Instruções caixa" // Protesto Intimação /// Exclusivo para formatar html da intimação Method New(f_cTxtArquivoLicensa) Constructor Method End() Method BoletoCbxAdd() Method BoletoCbxImprimir() Method BoletoCbxGerarRemessa() Method BoletoCbxCarregarRetorno() EndClass //----------------------------------------------------------------------------- Method End() Class BoletoCobreBemX If ::lInicializaCobrebemX ::oCobreBemX := Nil EndIf Return Nil //----------------------------------------------------------------------------- Method New(f_cTxtArquivoLicensa, f_Impressora) Class BoletoCobreBemX Local oError ::cTxtArquivoLicensa := f_cTxtArquivoLicensa ::lGerarRemessa := .F. Try ::oCobreBemX := TOleAuto():New("CobreBemX.ContaCorrente") ::lInicializaCobrebemX := .T. Catch oError MsgStop("Componente CobreBemX não esta Instalado neste computador."+CRLF+; "Favor efetuar o Registro do Componente.",; "Procedimento abortado.") ::lInicializaCobrebemX := .F. End Try If ::lInicializaCobrebemX ::oCobreBemX:ArquivoLicencaTexto := ::cTxtArquivoLicensa ::oCobreBemX:PadroesBoleto:PadroesBoletoImpresso:MargemSuperior := 6 ::oCobreBemX:PadroesBoleto:PadroesBoletoImpresso:ArquivoLogotipo := "c:\CobreBemX\Imagens\BannerCBX.gif" ::oCobreBemX:PadroesBoleto:PadroesBoletoImpresso:CaminhoImagensCodigoBarras := DIR_BOLETO() ::oCobreBemX:PadroesBoleto:PadroesBoletoImpresso:NomeImpressora := f_Impressora ///::oCobreBemX:PadroesBoleto:PadroesBoletoImpresso:LayoutBoleto := "CarnetReciboTopoPersonalizado" ::oCobreBemX:InicioNossoNumero := ::cInicioNossoNumero ::oCobreBemX:FimNossoNumero := ::cFimNossoNumero ::oCobreBemX:ArquivoRemessa:Arquivo := ::cArquivoRemessaNome ::oCobreBemX:ArquivoRemessa:Diretorio := ::cArquivoRemessaPasta EndIf Return Self //----------------------------------------------------------------------------- Method BoletoCbxAdd() Class BoletoCobreBemX ::oCobreBemX:CodigoAgencia := ::cCodigoAgencia ::oCobreBemX:NumeroContaCorrente := ::cNumeroContaCorrente ::oCobreBemX:CodigoCedente := ::cCodigoCedente ::oCobreBemX:ProximoNossoNumero := ::cProximoNossoNumero ::oBoleto := ::oCobreBemX:DocumentosCobranca:Add() // Monta dados do sacado ::oBoleto:NomeSacado := ::cNomeSacado ::oBoleto:CPFSacado := ::cCPFSacado ::oBoleto:EnderecoSacado := ::cEnderecoSacado ::oBoleto:BairroSacado := ::cBairroSacado ::oBoleto:CidadeSacado := ::cCidadeSacado ::oBoleto:EstadoSacado := ::cEstadoSacado ::oBoleto:CepSacado := ::cCepSacado // Monta dados do documento de cobrança ::oBoleto:DataVencimento := ::cDataVencimento ::oBoleto:NumeroDocumento := ::cNumeroDocumento ::oBoleto:ValorDocumento := ::nValorDocumento ::oBoleto:ValorDesconto := ::nValorDesconto ::oBoleto:PadroesBoleto:Demonstrativo := ::cDemonstrativo ::oBoleto:PadroesBoleto:InstrucoesCaixa := ::cInstrucoesCaixa ::nPaginaAtual ++ ::oCobreBemX:CALCULARDADOSBOLETOS() ::cNossoNumeroGerado := ::oBoleto:NossoNumero Return Nil //----------------------------------------------------------------------------- Method BoletoCbxImprimir() Class BoletoCobreBemX If GetKeyState(VK_SHIFT) ::oCobreBemX:ImprimeBoletos() Else ::oCobreBemX:ImprimeBoletosSemPreview() EndIf Return Nil //----------------------------------------------------------------------------- Method BoletoCbxGerarRemessa() Class BoletoCobreBemX ::oCobreBemX:ArquivoRemessa:Arquivo := ::cArquivoRemessaNome ::oCobreBemX:ArquivoRemessa:Diretorio := ::cArquivoRemessaPasta ::oCobreBemX:GravaArquivoRemessa() Return Nil //----------------------------------------------------------------------------- Method BoletoCbxCarregarRetorno() Class BoletoCobreBemX Local nOcorrencias := 0, iFor := 0, cTmpArquivo := "", cTmpDiretorio := "" cTmpArquivo := SubStr(::cArquivoRetorno,Rat("\",::cArquivoRetorno)+1) cTmpDiretorio := SubStr(::cArquivoRetorno,1,Rat("\",::cArquivoRetorno)) ::oCobreBemX:ArquivoRetorno:Arquivo := cTmpArquivo ::oCobreBemX:ArquivoRetorno:Diretorio := cTmpDiretorio ::oCobreBemX:CarregaArquivosRetorno() ::aRetornoOcorrencias := {} nOcorrencias := ::oCobreBemX:OcorrenciasCobranca:Count-1 For Ifor := 0 To nOcorrencias aadd(::aRetornoOcorrencias,{::oCobreBemX:OcorrenciasCobranca[iFor]:NossoNumero,; // A - 01 Char ::oCobreBemX:OcorrenciasCobranca[iFor]:CodigoOcorrencia,; // B - 02 Char ::oCobreBemX:OcorrenciasCobranca[iFor]:DataOcorrencia,; // C - 03 Char ::oCobreBemX:OcorrenciasCobranca[iFor]:Pagamento,; // D - 04 Logic ::oCobreBemX:OcorrenciasCobranca[iFor]:ValorPago,; // E - 05 Numeric ::oCobreBemX:OcorrenciasCobranca[iFor]:ValorMultaPaga,; // F - 06 Numeric ::oCobreBemX:OcorrenciasCobranca[iFor]:ValorJurosPago,; // G - 07 Numeric ::oCobreBemX:OcorrenciasCobranca[iFor]:ValorTaxaCobranca,; // H - 08 Numeric ::oCobreBemX:OcorrenciasCobranca[iFor]:ValorCredito,; // I - 09 Numeric ::oCobreBemX:OcorrenciasCobranca[iFor]:NumeroDocumento,; // J - 10 Char ::oCobreBemX:OcorrenciasCobranca[iFor]:ValorDesconto,; // K - 11 Numeric ::oCobreBemX:OcorrenciasCobranca[iFor]:Banco,; // L - 12 Char ::oCobreBemX:OcorrenciasCobranca[iFor]:Carteira,; // M - 13 Char ::oCobreBemX:OcorrenciasCobranca[iFor]:Agencia,; // N - 14 Char ::oCobreBemX:OcorrenciasCobranca[iFor]:ContaCorrente,; // O - 15 Char ::oCobreBemX:OcorrenciasCobranca[iFor]:CodigoCedente,; // P - 16 Char ::oCobreBemX:OcorrenciasCobranca[iFor]:NumeroControle,; // Q - 17 Char ::oCobreBemX:OcorrenciasCobranca[iFor]:ValorOutrosAcrescimos}) // R - 18 Numeric Next //xBrowse(::aRetornoOcorrencias) Return Nil

Simples, quando o dialog esta fora de focus ele fica transparent, quando volta ele reaparece normal. Veja a figura abaixo, o dialogo que esta por traz fica transparente.

Para quem gosta de efeitos, é só compilar junto com o sistema e chamar a função: SetAutoTransp Ex: SetAutoTransp(.T.,200) // .T. Para acionar o efeito e 200 o fator da transparencia (quanto menor mais transparente fica) Tem que criar um prg com o código abaixo com o nome de dialog.prg LEMBRANDO QUE FUNCIONA NO WINDOWS 7 E 8, NO XP TIVE PROBLEMAS DIALOG.PRG #include "FiveWin.ch" #include "Constant.ch" #define LTGRAY_BRUSH 1 #define GRAY_BRUSH 2 #define WM_CTLCOLOR 25 // 0x19 // Don't remove Color Control #define WM_ERASEBKGND 20 // 0x0014 // or controls will not shown // colors !!! #define WM_DRAWITEM 43 // 0x002B #define WM_MEASUREITEM 44 // 0x002C #define WM_SETFONT 48 #define WM_SETICON 128 #define WM_NCPAINT 133 // 0x085 #define WM_PRINTCLIENT 792 #define CBN_SELCHANGE 1 #define CBN_CLOSEUP 8 #define GWL_STYLE -16 #define GW_CHILD 5 #define GW_HWNDNEXT 2 #define GWL_EXSTYLE -20 #define COLOR_BTNFACE 15 #define COLOR_BTNTEXT 18 #define SC_HELP 61824 #define FN_ZIP 15001 #define WS_EX_CONTEXTHELP 1024 #define SWP_NOZORDER 4 #define SWP_NOREDRAW 8 #define SWP_NOACTIVATE 16 #define SC_CLOSE 61536 // 0xF060 #define SW_HIDE 0 extern Set static aGradColors // Colors to use to GRADIENT dialogs static lAutoTransp := .F. // set auto transparence on focus / no focus Static nFatorTransp := 220 //----------------------------------------------------------------------------// CLASS TDialog FROM TWindow CLASSDATA lRegistered AS LOGICAL DATA cResName, cResData DATA hResources DATA lCentered, lCenterInWnd, lModal, lModify DATA bStart DATA lHelpIcon // Windows 95 help icon pressed DATA lResize16 // resize 32 bits resources to look like 16 bits ones DATA lTransparent // transparent controls when using bitmaped brushes DATA bNcActivate Data lDialogTransp INIT .F. Data cWindows init cWinVersion() METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cResName, hResources,; lVbx, nStyle, nClrText, nClrBack, oBrush, oWnd, lPixels,; oIco, oFont, nHelpId, nWidth, nHeight, lTransparent, aNewGradColors ) CONSTRUCTOR METHOD Define( nTop, nLeft, nBottom, nRight, cCaption, nStyle,; nClrText, nClrPane, oBrush ) CONSTRUCTOR METHOD Activate( bClicked, bMoved, bPainted, lCentered, bValid, lModal,; bInit, bRClicked, bWhen, lResize16, lCenterInWnd ) METHOD AdjTop() INLINE WndAdjTop( ::hWnd ) METHOD ChangeFocus() INLINE ::PostMsg( FM_CHANGEFOCUS ) METHOD Close( nResult ) METHOD Command( nWParam, nLParam ) METHOD CtlColor( hWndChild, hDCChild ) METHOD cGenPrg() METHOD cToChar( hActiveWnd ) METHOD DefControl( oControl ) METHOD Destroy() INLINE Super:Destroy(), If( ! ::lModal, .t., nil ) METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(),; If( ::bStart != nil,; Eval( ::bStart, ::bStart := nil ),), .f. METHOD ReSize( nSizeType, nWidth, nHeight ) INLINE ( ::Super:Resize( nSizeType, nWidth, nHeight ), ::Refresh() ) METhod End( nResult ) METHOD EraseBkGnd( hDC ) METHOD GetHotPos( nChar, hCtrlAt ) METHOD GetItem( nId ) INLINE GetDlgItem( ::hWnd, nId ) METHOD GotFocus() INLINE ::lFocused := .t.,; If( ::bGotFocus != nil, Eval( ::bGotFocus ), nil ) METHOD HandleEvent( nMsg, nWParam, nLParam ) METHOD Help( nWParam, nLParam ) METHOD Initiate( hWndFocus, hWnd ) METHOD KeyChar( nKey, nFlags ) METHOD KeyDown( nKey, nFlags ) METHOD LostFocus() INLINE ::lFocused := .f.,; If( ::bLostFocus != nil, Eval( ::bLostFocus ), nil ) METHOD MouseMove( nRow, nCol, nKeyFlags ) METHOD NCActivate( lOnOff ) INLINE If( ! Empty( ::bNcActivate ), Eval( ::bNcActivate, lOnOff, Self ),) METHOD Paint() METHOD PrintClient( hDC ) INLINE 1 METHOD QueryEndSession() INLINE ! ::End() METHOD SetControl( oCtrl ) INLINE ; ::oClient := oCtrl, ::ReSize() METHOD SetFont( oFont ) METHOD SetSize( nWidth, nHeight, lRepaint ) INLINE ; Super:SetSize( nWidth, nHeight, lRepaint ),; If( aGradColors != nil, ::Gradient( aGradColors ),) METHOD SysCommand( nWParam, nLParam ) METHOD VbxFireEvent( pEventInfo ) INLINE VBXEvent( pEventInfo ) METHOD Help95() ENDCLASS //----------------------------------------------------------------------------// METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cResName, hResources,; lVbx, nStyle, nClrText, nClrBack, oBrush, oWnd, lPixels,; oIco, oFont, nHelpId, nWidth, nHeight, lTransparent, aNewGradColors ) CLASS TDialog DEFAULT hResources := GetResources(), lVbx := .f.,; nClrText := GetSysColor( COLOR_BTNTEXT ), nClrBack := GetSysColor( COLOR_BTNFACE ),; lPixels := .f., nTop := 0, nLeft := 0, nBottom := 10, nRight := 40,; nWidth := 0, nHeight := 0, lTransparent := .f.,; nStyle := nOR( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU ) if nWidth != 0 .or. nHeight != 0 if ! lPixels lPixels = .t. endif nBottom = nHeight nRight = nWidth endif if ! Empty( aNewGradColors ) .or. ! Empty( aGradColors ) lTransparent = .T. endif ::aControls = {} ::cResName = cResName ::cCaption = cCaption ::hResources = hResources ::lModify = .t. ::lVbx = lVbx ::lVisible = .f. ::nResult = 0 ::nStyle = nStyle ::oWnd = oWnd ::oIcon = oIco ::oFont = oFont ::nLastKey = 0 ::nHelpId = nHelpId ::lResize16 = .f. ::lTransparent = lTransparent ::aGradColors = aNewGradColors // ::lHelpIcon = .t. if ValType( oIco ) == "C" if File( oIco ) DEFINE ICON oIco FILENAME oIco else DEFINE ICON oIco RESOURCE oIco endif ::oIcon := oIco endif ::SetColor( nClrText, nClrBack, oBrush ) if lPixels // New PIXELS Clausule ::nTop = nTop ::nLeft = nLeft ::nBottom = nBottom ::nRight = nRight else // Compatibility ::nTop := int( nTop * DLG_CHARPIX_H ) ::nLeft := int( nLeft * DLG_CHARPIX_W ) ::nBottom := int( nBottom * DLG_CHARPIX_H ) ::nRight := int( nRight * DLG_CHARPIX_W ) endif if lVbx if ! VbxInit( GetInstance(), "" ) MsgAlert( "VBX support not available" ) endif endif ::Register( nOr( CS_VREDRAW, CS_HREDRAW ) ) SetWndDefault( Self ) // Set Default DEFINEd Window return Self //----------------------------------------------------------------------------// METHOD Activate( bLClicked, bMoved, bPainted, lCentered, ; bValid, lModal, bInit, bRClicked, bWhen, lResize16, ; lCenterInWnd ) CLASS TDialog static nDlgCount := 0 local hActiveWnd, hWnd, bDlgProc DEFAULT lCentered := .f., lModal := .t., ::hWnd := 0, lResize16 := .f., lCenterInWnd := .f. ::nLastKey = 0 ++nDlgCount hActiveWnd = If( ::oWnd != nil, ::oWnd:hWnd,; If( nDlgCount > 1 .or. lWRunning(),; GetActiveWindow(), GetWndApp() ) ) ::lCentered = lCentered ::lCenterInWnd = lCenterInWnd ::lModal = lModal ::bLClicked = bLClicked ::bRClicked = bRClicked ::bWhen = bWhen ::bValid = bValid ::bInit = bInit ::bPainted = bPainted ::bMoved = bMoved ::nResult = nil ::lValidating = .f. ::lVisible = .t. ::lResize16 = lResize16 if ::bWhen != nil if ! Eval( ::bWhen, Self ) ::nResult = IDCANCEL ::lVisible = .F. return nil endif endif if lModal ::nResult = if( ! Empty( ::cResName ),; DialogBox( ::hResources, ::cResName,; hActiveWnd, Self ),; DialogBoxIndirect( GetInstance(),; If( ! Empty( ::cResData ), ::cResData, ::cToChar( hActiveWnd ) ),; hActiveWnd, Self ) ) if ::nResult == 65535 CreateDlgError( Self ) endif else if ( Len( ::aControls ) > 0 .and. CanRegDialog() ) .or. ; Len( ::aControls ) == 0 if ! Empty( ::cResName ) ::hWnd = CreateDlg( ::hResources, ::cResName, hActiveWnd ) else ::hWnd = CreateDlgIndirect( GetInstance(), ::cToChar( hActiveWnd ),; hActiveWnd ) endif if ::hWnd == 0 CreateDlgError( Self ) else ::Hide() ShowWindow( ::hWnd, SW_HIDE ) endif if Len( ::aControls ) > 0 .and. ! RegDialog( ::hWnd ) ::SendMsg( WM_CLOSE ) MsgAlert( "Not possible to create more non-modal Dialogs" ) endif if ::Initiate() ::SetFocus() endif ::Show() ::Refresh() // needed for resource dialogs else MsgAlert( "Not possible to create more non-modal Dialogs" ) endif endif nDlgCount-- if ::lModal ::lVisible = .f. endif return nil //---------------------------------------------------------------------------// METHOD DefControl( oCtrl ) CLASS TDialog DEFAULT oCtrl:nId := oCtrl:GetNewId() if AScan( ::aControls, { | o | o:nId == oCtrl:nId } ) > 0 #define DUPLICATED_CONTROLID 2 Eval( ErrorBlock(), _FWGenError( DUPLICATED_CONTROLID, ; "No: " + Str( oCtrl:nId, 6 ) ) ) else AAdd( ::aControls, oCtrl ) oCtrl:hWnd = 0 endif return nil //----------------------------------------------------------------------------// METHOD Command( nWParam, nLParam ) CLASS TDialog local oWnd, nNotifyCode, nID, hWndCtl nNotifyCode = nHiWord( nWParam ) nID = nLoWord( nWParam ) hWndCtl = nLParam do case case ::oPopup != nil ::oPopup:Command( nID ) case hWndCtl == 0 .and. ::oMenu != nil .and. ; If( nNotifyCode == BN_CLICKED, nID != IDCANCEL, .f. ) ::oMenu:Command( nID ) case GetClassName( hWndCtl ) == "ToolbarWindow32" oWndFromHwnd( hWndCtl ):Command( nWParam, nLParam ) case nID != 0 do case case nNotifyCode == BN_CLICKED if hWndCtl != 0 .and. nID != IDCANCEL oWnd := oWndFromhWnd( hWndCtl ) if ValType( ::nResult ) == "O" // latest control which had focus // There is a pending Valid, it is not a clicked button if oWnd != nil if ! oWnd:lCancel if ::nResult:nID != nID .and. ! ::nResult:lValid() return nil endif endif else if ::nResult:nID != nID .and. ! ::nResult:lValid() return nil endif endif endif if AScan( ::aControls, { |o| o:nID == nID } ) > 0 #ifdef __XPP__ PostMessage( hWndCtl, FM_CLICK, 0, 0 ) #else SendMessage( hWndCtl, FM_CLICK, 0, 0 ) #endif elseif nID == IDOK ::End( IDOK ) endif else if nID == IDOK ::GoNextCtrl( GetFocus() ) if ! ::lModal return 0 endif elseif hWndCtl != 0 .and. ; // There is a control for IDCANCEL AScan( ::aControls, { |o| o:nID == nID } ) > 0 SendMessage( hWndCtl, FM_CLICK, 0, 0 ) return .F. else ::End( IDCANCEL ) endif endif case nNotifyCode == CBN_SELCHANGE SendMessage( hWndCtl, FM_CHANGE, 0, 0 ) case nNotifyCode == CBN_CLOSEUP SendMessage( hWndCtl, FM_CLOSEUP, 0, 0 ) #ifdef __CLIPPER__ case nID == FN_ZIP // FiveWin notifications codes ::Zip( nLParam ) case nID == FN_UNZIP ::UnZip( nPtrWord( nLParam ) ) #endif endcase endcase return nil //----------------------------------------------------------------------------// METHOD CtlColor( hWndChild, hDCChild ) CLASS TDialog local uVal if ::oWnd != nil .and. Upper( ::oWnd:ClassName() ) $ "TFOLDER,TFOLDEREX,TPAGES" ; .and. GetClassName( hWndChild ) $ "Button,Static" ; .and. IsAppThemed() uVal = DrawThemed( hWndChild, hDCChild ) SendMessage( hWndChild, FM_COLOR, hDCChild ) return uVal endif return Super:CtlColor( hWndChild, hDCChild ) //----------------------------------------------------------------------------// METHOD cGenPrg() CLASS TDialog local cSource := Super:cGenPrg( , .T. ) // use dialog units cSource = StrTran( cSource, "WINDOW", "DIALOG" ) cSource = StrTran( cSource, "oWnd", "oDlg" ) return cSource //----------------------------------------------------------------------------// METHOD cToChar( hActiveWnd ) CLASS TDialog local cResult local aControls := ::aControls local n := GetDlgBaseUnits() local aRect := GetWndRect( hActiveWnd ) DEFAULT ::cCaption := "" cResult = cDlg2Chr( Len( aControls ),; Int( 8 * ( ::nTop - aRect[ 1 ] ) / nHiWord( n ) ),; Int( 4 * ( ::nLeft - aRect[ 2 ] ) / nLoWord( n ) ),; Int( 8 * ( ::nBottom - aRect[ 1 ] ) / nHiWord( n ) ),; Int( 4 * ( ::nRight - aRect[ 2 ] ) / nLoWord( n ) ),; ::cCaption, ::nStyle ) for n = 1 to Len( aControls ) cResult += aControls[ n ]:cToChar() next return cResult //----------------------------------------------------------------------------// METHOD Define( nTop, nLeft, nBottom, nRight, cCaption, nStyle, lVbx,; nClrText, nClrBack, oBrush ) CLASS TDialog DEFAULT lVbx := .f.,; nClrText := GetSysColor( COLOR_BTNTEXT ), nClrBack := GetSysColor( COLOR_BTNFACE ) ::hWnd = 0 ::nTop = nTop ::nLeft = nLeft ::nBottom = nBottom ::nRight = nRight ::cCaption = cCaption ::nStyle = nStyle ::lVbx = lVbx ::nLastKey = 0 // ::lHelpIcon = .t. ::SetColor( nClrText, nClrBack, oBrush ) return Self //----------------------------------------------------------------------------// METHOD End( nResult ) CLASS TDialog DEFAULT nResult := 2 // Cancel if ! ::lModal ///AnimateWindow( gethwnd32(::hWnd), 200, nOr(65536 ,524288) ) ::PostMsg( WM_CLOSE, nResult ) else if ValType( ::bValid ) == "B" if ! Eval( ::bValid, Self ) return .f. endif endif ::nResult = nResult EndDialog( ::hWnd, nResult ) endif SysRefresh() hb_gcAll() // Garbage collector return .T. //----------------------------------------------------------------------------// // Conection with Borland's VBX DLL - at run-time !!! DLL STATIC FUNCTION VbxInitDialog( hWnd AS WORD, hInstance AS WORD,; cResName AS STRING ) AS BOOL PASCAL LIB "BIVBX10.DLL" DLL STATIC FUNCTION VbxInit( hInstance AS WORD, cPrefix AS STRING ) ; AS BOOL PASCAL LIB "BIVBX10.DLL" DLL STATIC FUNCTION VbxTerm() AS VOID PASCAL LIB "BIVBX10.DLL" //----------------------------------------------------------------------------// static function CreateDlgError( Self ) local cRes := If( ValType( ::cResName ) == "N", Str( ::cResName ), ::cResName ) local cPad := Replicate( Chr( 32 ), 22 ) #define CANNOTCREATE_DIALOG 3 Eval( ErrorBlock(), ; _FwGenError( CANNOTCREATE_DIALOG, CRLF + cPad + ; If( ! Empty( cRes ), "Resource: " + cRes,; "Title: " + If( Empty( ::cCaption ), "", ::cCaption ) ) ) ) return nil //----------------------------------------------------------------------------// METHOD GetHotPos( nChar, hCtrlAt ) CLASS TDialog local hCtrl := GetWindow( ::hWnd, GW_CHILD ) local nAt, cText while hCtrl != 0 if hCtrl != hCtrlAt .and. GetParent( hCtrl ) == ::hWnd .and. ; IsWindowEnabled( hCtrl ) .and. ; ( nAt := At( "&", cText := GetWindowText( hCtrl ) ) ) != 0 .and. ; Lower( SubStr( cText, nAt + 1, 1 ) ) == Lower( Chr( nChar ) ) while Upper( GetClassName( hCtrl ) ) == "STATIC" .and. hCtrl != 0 hCtrl = GetWindow( hCtrl, GW_HWNDNEXT ) end return hCtrl else hCtrl = GetWindow( hCtrl, GW_HWNDNEXT ) endif end return 0 //----------------------------------------------------------------------------// METHOD Help( nWParam, nLParam ) CLASS TDialog local hWndChild := HelpCtrlHwnd( nLParam ), nAtChild static lShow := .f. ::lHelpIcon = .f. if ! lShow lShow = .t. if ( nAtChild := AScan( ::aControls, { | o | o:hWnd == hWndChild } ) ) != 0 .and. ; ! Empty( ::aControls[ nAtChild ]:nHelpID ) ::aControls[ nAtChild ]:HelpTopic() else ::HelpTopic() endif lShow = .f. return 1 endif return nil //----------------------------------------------------------------------------// METHOD Initiate( hWndFocus, hWnd ) CLASS TDialog local lFocus := .t., lResult, hCtrl, lEnd := .f., aRect local oParentWnd if hWnd != nil ::hWnd = hWnd endif if ! ::lModal ::Link() endif if ::lVbx if ! VbxInitDialog( ::hWnd, GetResources(), ::cResName ) MsgAlert( "Error on VBX's initialization" ) endif endif if ::oFont == nil ::GetFont() else ::SetFont( ::oFont ) endif if ! Empty( ::aGradColors ) ::Gradient( ::aGradColors ) elseif ! Empty( aGradColors ) ::Gradient( aGradColors ) endif if ::lTransparent FixSays( ::hWnd, ::oBrush:hBrush ) AEval( ::aControls,; { | o | If( ! Upper( o:ClassName() ) $ ; "TGET;TMULTIGET;TBTNBMP;TCOMBOBOX;TWBROWSE;TCBROWSE;TXBROWSE;TLISTBOX;TDBCOMBO;TDATEPICK" .and. ; ! o:IsKindOf( 'TXBROWSE' ), o:lTransparent := .T., ) } ) endif ASend( ::aControls, "INITIATE()", ::hWnd ) #define SCALE_FACTOR 1.16668 if ::lResize16 .and. ! Empty( ::cResName ) ::nWidth = ::nWidth * SCALE_FACTOR hCtrl = GetWindow( ::hWnd, GW_CHILD ) if hCtrl != 0 while ! lEnd aRect = GetCoors( hCtrl ) SetWindowPos( hCtrl, 0, aRect[ 1 ], aRect[ 2 ] * SCALE_FACTOR,; ( aRect[ 4 ] - aRect[ 2 ] ) * SCALE_FACTOR,; aRect[ 3 ] - aRect[ 1 ], nOr( SWP_NOZORDER,; SWP_NOREDRAW, SWP_NOACTIVATE ) ) hCtrl = GetWindow( hCtrl, GW_HWNDNEXT ) lEnd = ! ( ( hCtrl != 0 ) .and. ( GetParent( hCtrl ) == ::hWnd ) ) end endif endif if ::lCentered if SetCenterOnParent() .or. ::lCenterInWnd oParentWnd := If( ::oWnd != nil, ::oWnd, WndMain() ) endif WndCenter( ::hWnd, If( oParentWnd != nil, oParentWnd:hWnd, 0 ) ) else if Empty( ::cResName ) .and. Empty( ::cResData ) ::Move( ::nTop, ::nLeft ) endif endif if ::cCaption != nil ::SetText( ::cCaption ) endif if ! Empty( ::cResName ) ::nStyle := GetWindowLong( ::hWnd, GWL_STYLE ) endif if lAnd( ::nStyle, WS_VSCROLL ) DEFINE SCROLLBAR ::oVScroll VERTICAL OF Self endif if lAnd( ::nStyle, WS_HSCROLL ) DEFINE SCROLLBAR ::oHScroll HORIZONTAL OF Self endif if ::oIcon != nil ::SendMsg( WM_SETICON, 0, ::oIcon:hIcon ) endif ::SetAlphaLevel() if ::bInit != nil lResult = Eval( ::bInit, Self ) if ValType( lResult ) == "L" .and. ! lResult lFocus = .f. endif endif ::Help95() // activates the help icon on the caption ::AEvalWhen() return lFocus // .t. for default focus //----------------------------------------------------------------------------// METHOD EraseBkGnd( hDC ) CLASS TDialog if ! Empty( ::bEraseBkGnd ) return Eval( ::bEraseBkGnd, hDC ) endif if ::oBrush != nil ::PaintBack( hDC ) return 1 endif return nil //----------------------------------------------------------------------------// METHOD Close( nResult ) CLASS TDialog if ! ::lModal if ValType( ::bValid ) == "B" if ! Eval( ::bValid, Self ) return .F. endif endif if ValType( nResult ) $ "NU" ::nResult = nResult endif ::lVisible = .F. DestroyWindow( ::hWnd ) return .T. endif return nil //----------------------------------------------------------------------------// METHOD KeyChar( nKey, nFlags ) CLASS TDialog if nKey == VK_ESCAPE if ::oWnd != nil .and. ( ::oWnd:IsKindOf( "TMDICHILD" ) .or. ; ::oWnd:IsKindOf( "TDIALOG" ) .or. ::oWnd:IsKindOf( "TMDIFRAME" ) ) if SetDialogEsc() ::End() endif endif return nil endif return Super:KeyChar( nKey, nFlags ) //----------------------------------------------------------------------------// METHOD KeyDown( nKey, nFlags ) CLASS TDialog if nKey == VK_ESCAPE if ::oWnd == nil if SetDialogEsc() ::End() endif else if ::oWnd:IsKindOf( "TMDICHILD" ) if SetDialogEsc() ::End() endif else if ::oWnd:IsKindOf( "TDIALOG" ) if SetDialogEsc() ::End() endif elseif Upper( ::oWnd:ClassName() ) == "TMDIFRAME" if SetDialogEsc() // To avoid ESC being ignored ::End() endif else return Super:KeyDown( nKey, nFlags ) endif endif endif else return Super:KeyDown( nKey, nFlags ) endif return nil //----------------------------------------------------------------------------// METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TDialog if ::lHelpIcon != nil .and. ! ::lHelpIcon if ::oCursor != nil SetCursor( ::oCursor:hCursor ) else CursorArrow() endif endif ::SetMsg( ::cMsg ) ::CheckToolTip() if ::bMMoved != nil return Eval( ::bMMoved, nRow, nCol, nKeyFlags ) endif return .f. //----------------------------------------------------------------------------// METHOD Paint() CLASS TDialog local uVal if ValType( ::bPainted ) == "B" uVal = Eval( ::bPainted, ::hDC, ::cPS, Self ) endif return uVal //----------------------------------------------------------------------------// METHOD SetFont( oFont ) CLASS TDialog local hDlg := ::hWnd local hCtrl := GetWindow( hDlg, GW_CHILD ) local hFont := If( ::oFont != nil, ::oFont:hFont, 0 ) Super:SetFont( oFont ) if hFont != 0 while hCtrl != 0 .and. GetParent( hCtrl ) == hDlg SendMessage( hCtrl, WM_SETFONT, hFont, 1 ) hCtrl = GetWindow( hCtrl, GW_HWNDNEXT ) end endif return nil //----------------------------------------------------------------------------// METHOD SysCommand( nWParam, nLParam ) CLASS TDialog if nWParam == SC_CLOSE .and. ::lModal if GetCapture() != 0 ReleaseCapture() endif return .f. endif if nWParam == SC_HELP ::lHelpIcon = .t. return .f. endif return Super:SysCommand( nWParam, nLParam ) //----------------------------------------------------------------------------// METHOD Help95() CLASS TDialog if ::lHelpIcon == nil .or. ::lHelpIcon SetWindowLong( ::hWnd, GWL_EXSTYLE,; nOr( GetWindowLong( ::hWnd, GWL_EXSTYLE ), WS_EX_CONTEXTHELP ) ) endif return nil //----------------------------------------------------------------------------// METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TDialog If lAutoTransp .and. (::cWindows == "7" .or. ::cWindows == "8") If nMsg == 134 If nWParam == 1 /// In Focus If ::lDialogTransp ::lDialogTransp := .F. Api_DialogTransp(Self,255) EndIf Else /// Out Focus If !::lDialogTransp ::lDialogTransp := .T. Api_DialogTransp(Self,nFatorTransp) EndIf EndIf EndIf EndIf ///If GetKeyState(VK_SHIFT) /// LOGFILE("TESTE.TXT",{nMsg,nWParam,nLParam}) ///EndIf do case case nMsg == WM_INITDIALOG return ::Initiate( nWParam, nLParam ) case nMsg == WM_PAINT return ::Display() case nMsg == WM_PRINTCLIENT return ::PrintClient( nWParam ) case nMsg == WM_LBUTTONDOWN if ::lHelpIcon != nil .and. ::lHelpIcon ::Help() else return Super:HandleEvent( nMsg, nWParam, nLParam ) endif otherwise return Super:HandleEvent( nMsg, nWParam, nLParam ) endcase return nil //----------------------------------------------------------------------------// function SetDialogEsc( lOnOff ) local lOldStatus static lStatus := .T. lOldStatus = lStatus if PCount() == 1 .and. ValType( lOnOff ) == "L" lStatus = lOnOff endif return lOldStatus //----------------------------------------------------------------------------// function SetCenterOnParent( lOnOff ) local lOldStatus static lStatus := .F. lOldStatus = lStatus if PCount() == 1 .and. ValType( lOnOff ) == "L" lStatus = lOnOff endif return lOldStatus //----------------------------------------------------------------------------// function SetDlgGradient( aNewGradColors ) local aOldGradColors := aGradColors aGradColors = aNewGradColors return aOldGradColors //----------------------------------------------------------------------------// function SetAutoTransp( f_lTransp, f_nFator ) Default f_lTransp := .F., f_nFator := 220 lAutoTransp := f_lTransp nFatorTransp := f_nFator return Nil //----------------------------------------------------------------------------// STATIC FUNCTION Api_DialogTransp(f_oDlg,f_nFator) Local iRgb := nRgb(200,100,255), nStyle := 3 Default f_nFator := 255 SetWindowLong( f_oDlg:hWnd, -20, 524288) SetLayeredWindowATTributes( f_oDlg:hWnd, iRgb, f_nFator, nStyle) RETURN NIL

Sair do meio do programa pode deixar recursos abertos e algumas amarrações pendentes na memoria. O certo vc coloca no inicio do seu prg uma função para determinar que é para executar quando fechar o programa Para fechar invoque o comando abaixo WndMain():End() EXIT PROCEDURE SAIR() DBCLOSEALL() RESALLFREE() FREERESOURCES() RETURN

Para usar o PdfCreator automaticamente faz assim IF EMPTY( oPC := WIN_OLECreateObject( "PDFCreator.clsPDFCreator" ) ) MsgStop("Pdf Creator não esta instalado neste computador.",; "Prodedimento abortado") RETURN .F. ENDIF oPC:__hSink := __AxRegisterHandler( oPC:__hObj, {|X| nEvent := X} ) oPC:cStart( "/NoProcessingAtStartup" ) oPC:_cOption( "UseAutosave", 1 ) oPC:_cOption( "UseAutosaveDirectory", 1 ) oPC:_cOption( "AutosaveDirectory", "C:\TESTE\" ) oPC:_cOption( "AutosaveFilename", "MeuPdf.pdf" ) oPC:_cOption( "AutosaveFormat", 0 ) oPC:cDefaultPrinter := "PDFCreator" oPC:cClearCache() oPC:cPrinterStop := .F. PRINTER oPrnPdf NAME "Gerando pdf" ; to "PDFCreator" //modal DEFINE FONT oFnt1 NAME "Arial" SIZE 0,-20 OF oPrnPdf oPrnPdf:SetPortrait() nRcol := oPrnPdf:nlogpixelx()/2.54 nRlin := oPrnPdf:nlogpixely()/2.54 PAGE oPrnPdf:say(05*nRlin,05*nRcol,; "TESTE COM PDFCREATOR",; oFnt1,,,,0) ENDPAGE ENDPRINTER nTime := hb_milliseconds() DO WHILE nEvent == 0 .AND. (hb_milliseconds() - nTime) < 10000 hb_idleSleep( 0.5 ) /* The following dummy line is required to allow COM server to send event [Mindaugas] */ oPC:cOption("UseAutosave") ENDDO hb_idleSleep( 0.7 ) oPC:cClose()

Olá Giovanny... Em primeiro lugar, obrigado por compartilhar com a comunidade as suas experiências e conhecimentos com o uso do ADS. Estou tentando iniciar a migração do meu Sistema para SQL e pelo que ví no seu exemplo acima, posso usar o ADS para isso. Está correto ? Tenho que instalar alguma coisa nos meus Clientes ? Obrigado Oi Valdir. Sim, voce pode usar normalmente comandos Sql com a classe tAds e ainda usar seus codigos antigos tudo misturado. E a maior vantagem que tudo fica em OOP (programação Orientada ao Objeto ), muito pratico. Seria assim um exemplo basico: oDs_ListaVenda := tAds():DsNew(1) oDs_ListaVenda:cQrySql := "Select {Static} VENDAS.SeqLancamento, VENDAS.S_CODIGO, PRODUTOS.PRODUTO AS DESCR_PRODUTO, VENDAS.QtaVenda from SAIDAS AS VENDAS " +; "INNER JOIN PRODUTOS AS PRODUTOS ON PRODUTOS.CODIGO = VENDAS.S_CODIGO " +; "Where VENDAS.Dt_Lancamento >= _Data_Inicial_ and VENDAS.Dt_Lancamento <= _Data_Final_ ;" aadd(oDs_ListaVenda:aVarsSql,{"_Data_Inicial_",cToD("01/04/2014")}) aadd(oDs_ListaVenda:aVarsSql,{"_Data_Final_",Date()}) oDs_ListaVenda:DsExecute(200) (oDs_ListaVenda:cAlias)->(xBrowse()) Este ai retornaria os produtos q venderam neste periodo lembrando que a descrição do produto esta na tabela PRODUTOS por isto usamos INNER JOIN. Mais a vantagem maior é que com este resultado eu crio automaticamente outra tabela com estes campos gerados pela query. Crio um temporario e posso indexar o campo DESCR_PRODUTO tambem. e abrir como um RDD normal. é só eu colocar o parametro assim oDs_ListaVenda:ldsCursorsToTemp := .T. Na pasta de TADS chamada Ads Install tem as Dlls para voce instalar nos computadores. estas dlls são necessarias tanto na versão free local como na versão paga. Caso voce queira instalar um sistema remoto em um servidor para acesso via internet ou cliente/servidor voce pode pedir um trial de ads em: http://www.sap.com/pc/tech/database/software/advantage-database-server/index.html Qualquer outra duvida me adiciona no Skype: giovany.vecchi

Ola Oscar. Em primeira mão, para quem não trabalha com ads, temos a entender que o funcionamento do banco de dados não passa de um RDD comum como DBFCDX. Olhando por cima não passa disto mesmo ja que podemos usar as mesmas regras e fontes de um DBFCDX ou DBFNTX apenas definindo o RDDADS como Default. Mais o Ads vai muito alem disto, por isto voce pode usar de sua maneira como se fosse DBF normal usando APPEND, RLOCK, SKIP, REPLACE Etc Etc. Alem disto o ads proporciona relacionamento como qualquer banco de dados relacional tipo Mysql, FireBird, Oracle. A vantagem é que voce pode usar grande parte de seus fontes com comandos antigos estito DBFCDX e misturar com Querys Sql e outras funcionalidades do ads. O problema maior fica em um só desafio: "CONVERTER SEUS DBFS PARA ADT USANDO DICIONARIO DE DADOS" Para isto voce pode usar o utilitario Dbf2Advantage.exe Depois de criado o dicionario de dados voce seguira estes passos: 1 - Chama a função TADS_START_CONFIG() para o tads criar os ambientes de ADS 2 - Abra uma conexão e defina como padrão (Default / Por Falta), Ex: oConexaoDefault := tAdsConnection():New(1,.T.) oConexaoDefault:cDataDictionary := ".\DADOSADD\Gerente_Byte.add" oConexaoDefault:cSenhaConnect := "PassWord" oConexaoDefault:nTpConnect := 7 lConectou := oConexaoDefault:tAdsConnect() Em tAdsConnection():New(Numero_da_Conexão,Se_é_a_Conexão_Padrao) Depois disto voce podera usar seus fontes normais usando o comando USE ou DBUSEAREA(), O que muda no comando é que voce não precisa indicar a rora do arquivo que voce quer abrir e nem os indices que estão relacionados porque estas informações ficam dentro do dicionario de dados. Ex: Antes com DBFCDX: USE ".\DADOS\CLIENTES.DBF" ALIAS CLIENTES INDEX ".\CLIENTES.CDX" NEW SHARED Depois com Ads: USE CLIENTES ALIAS CLIENTES Isto vai proporcionar a voce um alivio ja que voce não vai precisar alterar todos seus fontes. Só que isto não basta, usando desta maneira antiga voce vai ficar muito limitado ainda. Voce pode usar os comandos antigos e ir alterando aos poucos com os novos conseitos. Tenho sistema que ta uma graça, Alguns modulos estão de quando era DBF CDX e outros com classes de tAds usando SQL. No momento estou desenvolvendo em meus sistema modulos para interligar cartorios e com os recursos que desenvolvi no tAds ta ficando muito bom. Voce podera ir mesclando os recursos com seus fontes de uma maneira pratica. Tipo assim: Quero abrir o cadastro de clientes do jeito que eu fazia antes USE CLIENTES ALIAS CLIENTES NEW SHARED depois quero fazer uma query em sql ou rdd sem atrapalhar o alias ja aberto Em Rdd convencional oDb_Clientes := tAds():NewRdd() // Abro aqui via rdd oDb_Clientes:Append() oDb_Clientes:VarPut("NOME","GIOVANY VECCHI") oDb_Clientes:Commit() oDb_Clientes:End() // Fecho o handle Em Rdd gerado por classe de tAds com a função tAds_CreateClassFromDatabase("CLIENTES") oDb_Clientes := DB_CLIENTES():OpenRdd() Em Sql usando DataSet de Ads oDs_Clientes := tAds():DsNew(1) // 1 é o tipo da query, significa de tem retorno de cursores ou handle oDs_Clientes:cQrySql := "Select * from CLIENTES Order By NOME" // Defino a query oDs_Clientes:DsExecute() // Executa a query Veja em Samples de tAds para entender. Outro esclarecimento que voce deve saber é que o ADS tem a versão gratis que não é Cliente/Servidor, Trabalha normalmente em rede mais o trafego é definido pela rede local. e a versão paga que funciona como Cliente/Servidor e internet. Nos Sample01.exe tem um exemplo que abre uma tabela no servidor da Cibertec no Mexico. Funciona como se fosse um MySql, FireBird etc. Antes eu tinha olhado para o MySql, mais decidi usar o ads por muitas vantagens que só quem usa como eu a anos pode entender. Ex: Imagina só eu tendo 3 lojas em 3 servidores diferentes, to falando em 3 servidores um em cada loja com seus dados separados. quero tirar um relatorio de vendas das 3 lojas. faço assim: 1 - Conecto na loja 1 busco todo resultado e trago para o terminal que esta executando a pesquisa 2 - Conecto na loja 2 faço a mesma coisa 3 - Conecto na loja 3 tambem Ai na minha maquina terei em buffer local os 3 resultados com varias tabelas das 3 lojas. dai vou mesclando os resultados das tabelas e posso gerar uma só com todas elas ou desejar a query que preciso conforme a necessidade desejada. Outra vantagem, depois de um resultado de uma query posso aplicar um filtro como se fosse o DBSETFILTER nela. O problema do ads é que não ha documentação para nossa linguagem. E o Rdd de harbour não esta preparado para trabalhar com objetos estilo C Sharp. Por isto eu criei o tAds. Então resumindo é assim: Voce pode usar seus fontes do jeito que esta e ir implantando as outras formas com o tempo. Lambrando que o ads não suporta indices com funções do usuario tipo NOME_SOBRENOME+MINHAFUNCAO("CAMPO") No help de Advantage tem a lista das funções que podem estar tanto nos indices como nas querys Qualquer duvida poste aqui ou me chame pelo Skype Skype: giovany.vecchi

Para quem não esta conseguindo baixar no 4shared postei no sendspace http://www.sendspace.com/file/12sn5z