Clique abaixo para nos ajudar
Conectar-se

Esqueci minha senha

Estamos no Facebook
Buscar
 
 

Resultados por:
 


Rechercher Busca avançada

Quem está conectado
18 usuários online :: Nenhum usuário registrado, Nenhum Invisível e 18 Visitantes :: 2 Motores de busca

Nenhum

[ Ver toda a lista ]


O recorde de usuários online foi de 468 em 1/3/2012, 10:43
Espessura do cursor intermitente

7/3/2017, 09:08 por Jefferson Matakas

Bom dia a todos !!

Existe uma opcao no windows que pode ser acessada atraves da 'central da …

Comentários: 0

DESENVOLVIMENTO EM REDES

4/3/2017, 18:45 por AJC

Pessoal tem ou conhece livros ou material para programação em
redes usando banco de dados nativo …

Comentários: 0

USAR REPORT FORM

30/12/2016, 09:06 por AJC

Pessoal bom dia,
Estou com um grande problema, já pesquisei muita coisa sobre report form, mas o …

Comentários: 4

Como preencher campos vazios

9/2/2017, 11:55 por Linghston

Pessoal boa tarde,

É o seguinte, eu preciso preencher os campos de uma coluna da tabela DBF que …

Comentários: 2

Enviar msg para WhatsAPP via VFP

7/2/2017, 10:31 por Eliana

Olá Pessoal!

Alguém sabe se é possível enviar mensagem para o WhatsAPP via VFP?


Grata


Comentários: 0

Estatísticas
Temos 7037 usuários registrados
O último usuário registrado atende pelo nome de GETULIO

Os nossos membros postaram um total de 31 mensagens em 17 assuntos

Estas funcoes sao muito interessantes mesmo leiam!!!

Ver o tópico anterior Ver o tópico seguinte Ir em baixo

Astúcia Estas funcoes sao muito interessantes mesmo leiam!!!

Mensagem por alceu11 em 18/12/2009, 16:44

Funções Interessantes
Ai Vai
PISCAR LABEL - EFEITO BLINK

Coloque um objeto do tipo container em seu form com a propriedade BACKSTYLE = 0
Despeje um objeto LABEL e um TIMER no CONTAINER.

Defina a propriedade Interval do objeto TIMER para 300 (este valor você pode alterar conforme sua preferência) e inclua a linha abaixo ao método TIMER :
Código:
This.Parent.label1.Visible = ! This.Parent.label1.Visible

VERIFICAR INSCRIÇÃO ESTADUAL

Para verificar a consistência das Inscrições estaduais dos diversos estados, a Secretaria da Receita disponibilizou uma DLL que faz a verificação com base no ESTADO e no NUMERO DE I.E. fornecido.

Inicialmente, é preciso se fazer o download da DLL.
Para baixá-la, clique no link abaixo.
[Você precisa estar registrado e conectado para ver este link.]
Salve em qualquer pasta, de preferência em ..\WINDOWS\SYSTEM

Usá-la é bastante simples :

Primeiramente, é preciso "declarar" a DLL

Código:
Declare Integer ConsisteInscricaoEstadual In DllInscE32.DLL String, String

Crie um programa PROINSC.PRG ou adicione o código abaixo em seu arquivo de procedures:

Código:
*-------------------------------------------------------------
* FUNCAO....: PROINSC()
* OBJETIVO..: Fazer checagem de INSCRIÇÃO ESTADUAL
* RETORNO...: .T. se for correto ou .F. se for errado
* PARÂMETROS: INSCRIÇÃO ESTADUAL (caracter)
*            ESTADO (caracter)
*-------------------------------------------------------------

FUNCTION PROINSC
Parameters IE, UF

** "limpar" a inscrição estadual para a verificação
IE = STRTRAN(IE,'.','')
IE = STRTRAN(IE,'-','')
IE = STRTRAN(IE,'/','')
IE = STRTRAN(IE,',','')
IE = STRTRAN(IE,'ME','')
IE = STRTRAN(IE,' ','')
IE = STRTRAN(IE,'P','')
IE = ALLTRIM(IE)
Return ConsisteInscricaoEstadual(IE, UF)=0

Para verificar o valor digitado pode-se colocar o código abaixo no VALID do Textbox.

Código:
IF NOT PROINSC(THIS.Value,This.Parent.CmbCli_Estado.Value)
  = MESSAGEBOX('INSCRIÇÃO ESTADUAL INVÁLIDA !', 48, 'Atenção')
  RETURN .F.
ENDIF
RETURN


VERIFICAR CNPJ
Código:
*------------------------------------------------------------
FUNCTION proCNPJ
* Parametro : CNPJ a verificar (C14)
* Retorna : .T. se confirmado
*------------------------------------------------------------

PARAMETERS wcgc
wn1 = VAL(SUBS(wcgc,01,1))
wn2 = VAL(SUBS(wcgc,02,1))
wn3 = VAL(SUBS(wcgc,03,1))
wn4 = VAL(SUBS(wcgc,04,1))
wn5 = VAL(SUBS(wcgc,05,1))
wn6 = VAL(SUBS(wcgc,06,1))
wn7 = VAL(SUBS(wcgc,07,1))
wn8 = VAL(SUBS(wcgc,08,1))
wn9 = VAL(SUBS(wcgc,09,1))
wn10 = VAL(SUBS(wcgc,10,1))
wn11 = VAL(SUBS(wcgc,11,1))
wn12 = VAL(SUBS(wcgc,12,1))
wn13 = VAL(SUBS(wcgc,13,1))
wn14 = VAL(SUBS(wcgc,14,1)
)

CALCULO DO 13o ALGARISMO

Código:
soma1  =  wn1*5+wn2*4+wn3*3+wn4*2+wn5*9+wn6*8+wn7*7+wn8*6+wn9*5+wn10*4+wn11*3+wn12*2
dig1    =  11 - MOD(soma1,11)
IF dig1 = 10 .OR. dig1 = 11
  dig1 = 0
ENDIF

IF dig1 <> wn13
  RETURN .F.
ENDIF

CALCULO DO 14o ALGARISMO

Código:
soma2  =  wn1*6+wn2*5+wn3*4+wn4*3+wn5*2+wn6*9+wn7*8+wn8*7+wn9*6+wn10*5+wn11*4+wn12*3+
wn13*2
dig2  =  11 - MOD(soma2,11)
IF dig2 = 10 .OR. dig2 = 11
  dig2 = 0
ENDIF

IF dig2 <> wn14
  RETURN .F.
ENDIF

RETURN .T.

VERIFICAR CPF

Código:
*------------------------------------------------------------
FUNCTION proCPF
* Parametro : CPF a verificar (C11)
* Retorna : .T. se confirmado
*------------------------------------------------------------
PARAMETERS wcpf

wn1 = VAL(SUBS(wcpf,01,1))
wn2 = VAL(SUBS(wcpf,02,1))
wn3 = VAL(SUBS(wcpf,03,1))
wn4 = VAL(SUBS(wcpf,04,1))
wn5 = VAL(SUBS(wcpf,05,1))
wn6 = VAL(SUBS(wcpf,06,1))
wn7 = VAL(SUBS(wcpf,07,1))
wn8 = VAL(SUBS(wcpf,08,1))
wn9 = VAL(SUBS(wcpf,09,1))
wn10 = VAL(SUBS(wcpf,10,1))
wn11 = VAL(SUBS(wcpf,11,1))

CALCULO DO 1o digito

Código:
soma1 = wn1*10+wn2*9+wn3*8+wn4*7+wn5*6+wn6*5+wn7*4+wn8*3+wn9*2
dig1  =  11 - MOD(soma1,11)

IF dig1 = 10 .OR. dig1 = 11
  dig1 = 0
ENDIF
IF dig1 <> wn10
  RETURN .F.
ENDIF

CALCULO DO 2o digito

Código:
soma2 = wn1*11+wn2*10+wn3*9+wn4*8+wn5*7+wn6*6+wn7*5+wn8*4+wn9*3+wn10*2
dig2  =  11 - MOD(soma2,11)

IF dig2 = 10 .OR. dig2 = 11
  dig2 = 0
ENDIF

IF dig2 <> wn11
  RETURN .F.
ENDIF

RETURN .T.
ENDFUNC

SABER SE UMA VARIÁVEL EXISTE
Use a função TYPE():

Código:
IF TYPE("Var")
  =MessageBox("Variável Existe",0,"")
ENDIF


COMO CRIAR UM HYPERLINK

Adicione a seu form um objeto "Label"

Na propriedade Caption, coloque um endereço da web, ex: [Você precisa estar registrado e conectado para ver este link.]
Marque a propriedade FontUnderline como .T.

No método click, coloque o código :

Código:
oIE = CREATEOBJECT("InternetExplorer.Application")
oIE.Navigate(This.Caption)
oIE.Visible = .T.

ou então :

Código:
LOCAL loHyperlink
loHyperlink = CREATEOBJECT("Hyperlink")
loHyperlink.navigateto(This.Caption)


Importar e Exportar Arquivos

Crie um Botão ou Em qualquer metodo e coloque assim

Importar

Código:
append from nome_do_arquivo.xls ou txt type xls ou txt


Exportar
Código:
copy to nome_do_arquivo.xls ou txt type xls ou txt

ENVIO DE FAX USANDO O WINFAX

Inicialmente, é preciso ter o WinFax instalado.
O programa se encontrava no cd de instalação do Win98 e do Win95, se não me engano.

Código:
oWinFax = CreateObject("WinFax.SDKSend")
oWinFax.SetSubject("Teste de Fax")
oWinFax.SetNumber("1234567")
oWinFax.SetAreaCode("555")
oWinFax.SetCompany("Empresa")
oWinFax.AddRecipient()  && Destinatário
oWinFax.SetPrintFromApp(1)
oWinFax.AddAttachmentFile("")  && aqui vai o arquivo
oWinFax.Send(1)

SET PRINTER TO NAME winfax
REPORT FORM MyReport TO PRINT NOCONSOLE
SET PRINTER TO
RELEASE oWinFax

ENVIO DE EMAILS USANDO O MENSAGEIRO PADRÃO

A maneira mais simplificada:


Código:
lcRecipient = "destinatario@xyz.com.br"
lcSubject  = "Assunto"
lcSubject  = "?subject=" + lcSubject
lcCC        = "Destinocopia@abc.com.br"
lcCC        = IIF(EMPTY(lcCC),"","&cc=" + lcCC)
lcBCC      = "Destinocopiaoculta@abc.com.br"
lcBCC      = IIF(EMPTY(lcBCC),"","&bcc= " + lcBCC)
lcBody      = "Este é o texto do corpo da mensagem"

lcMail = "mailto:" + lcRecipient + lcSubject + lcCC + lcBCC + lcBody

DECLARE INTEGER ShellExecute IN SHELL32.DLL;
      integer HndWin, string cAction, string cFileName,;
      STRING cParams, STRING cDir, INTEGER nShowWin

shellExecute(0,"OPEN",lcMail,"","",1)

Muito simples !!!
Ao usuário caberá apenas clicar no botão de enviar do programa padrão de email !!!

PS: Por este método não é possível se anexar arquivos

CONTROLANDO O VOLUME DO SOM

Pode-se chamar o programa SNDVOL32.EXE utilizando-se a API Shellexecute,
a partir de uma função, como a abaixo:

Código:
FUNCTION Shell
LPARAMETER lcLink, lcAction, lcParms, lcDir
lcAction = IIF(EMPTY(lcAction), "Open", lcAction)
lcParms = IIF(EMPTY(lcParms), "", lcParms)
lcDir=IIF(empty(lcDir),"",lcDir)
DECLARE INTEGER ShellExecute;
    IN SHELL32.dll;
    INTEGER nWinHandle,;
    STRING cOperation,;
    STRING cFileName,;
    STRING cParameters,;
    STRING cDir,;
    INTEGER nShowWindow

DECLARE INTEGER FindWindow;
  IN WIN32API;
  STRING cNull,STRING cWinName

RETURN ShellExecute(FindWindow(0, _SCREEN.caption),;
                    @lcAction, @lcLink,;
                    @lcParms, @lcDir, 1)

Para chamar o controlador de sons, use assim:

Código:
shell("sndvol32.exe")


Outra forma, seria utilizar uma DLL preparada por um colega latino,
Denny Infante Juarez, disponibilizada no PortalFox no link abaixo:

DLL Preparada

COMO SABER SE UM OBJETO TEM OU NÃO UMA PROPRIEDADE / MÉTODO

Código:
* se existe o método Release, executa
IF pemstatus(Thisform, 'RELEASE',5)
  Thisform.Release
ENDIF

NÃO DEIXAR QUE SEU EXECUTÁVEL RODE SIMULTANEAMENTE NA MESMA ESTAÇÃO

Normalmente, não queremos que um executável seja executado ao mesmo tempo mais de uma vez. Existem vária técnicas para isso, aí vai uma delas.

Modo de uso :
Coloque no programa inicial do seu sistema nas primeiras linhas:

Código:
IF NOT validar_sistema()
    QUIT
ENDIF

Salve como validar_sistema.PRG ou inclua em seu arquivo de procedures

Código:
FUNCTION validar_sistema

LOCAL lcOldCaption
lcOldCaption = _screen.Caption
_screen.Caption = SYS(3)

LOCAL lnhwnd
DECLARE INTEGER FindWindow IN Win32API STRING lpClassName, STRING lpWindowName
DECLARE INTEGER BringWindowToTop IN Win32API INTEGER HWND
DECLARE INTEGER SendMessage IN Win32API INTEGER HWND, INTEGER Msg, INTEGER WParam, INTEGER LPARAM
lnhwnd = findwindow( 0, lcOldCaption)
_screen.Caption = lcOldCaption
IF lnhwnd > 0
    bringwindowtotop(lnhwnd) && Mandar la ventana de la aplicación al frente
    sendmessage(lnhwnd, 274, 61488, 0) && Maximizar la ventana de la aplicación
    RETURN .F.
ENDIF
RETURN .T.

REMOVER UMA ABA DE UM PAGEFRAME

Código:
*-- Esconder a 2a pagina do PageFrame
thisform.PageFrame1.RemoveObject("Page2")

SABER SE UMA PASTA EXISTE

O simples exemplo abaixo cria uma pasta no sistema caso não exista uma com o nome desejado.

Código:
IF NOT DIRECTORY('c:\TEMP\')
  MKDIR ('c:\TEMP\')
ENDIF

COMO FECHAR TODOS OS FORMS

Código:
FOR i = 1 TO _Screen.formCount
_Screen.forms(i).release
ENDFOR

ou então

Código:
LOCAL loForm
FOR EACH loForm IN _SCREEN.FORM
loForm.RELEASE()
NEXT

OBTER O IP LOCAL DA MÁQUINA

Código:
oSocket = CreateObject("MSWinsock.Winsock")
? oSocket.LocalIP

SABER SE O DRIVE DE DISKETE A ESTÁ PRONTO OU POSSUI UM DISCO

Código:
IF DISKSPACE("A:\") = -1
  MESSAGEBOX("Não há disco no Drive A",48,"Erro")
ENDIF

CRIAR UM EXECUTÁVEL RAPIDAMENTE A PARTIR DE UM PRG

Código:

BUILD PROJECT TempProj FROM myprg
BUILD EXE myexe FROM TempProj
ERASE TempProj.pj?

FINALIZAR TODAS AS TRANSAÇÕES ABERTAS

Eventualmente, em situações de erro no programa, precisamos finalizar todas as transações abertas.

Código:
DO WHILE TXNLEVEL() > 0
  ROLLBACK
ENDDO

MOVER O CURSOR PARA O INICIO DO TEXTBOX

Eventualmente alguém pede para que o cursor vá automaticamente para o início do texto qdo um TEXTBOX é clicado.

No evento CLICK do Textbox, basta colocar :
Código:
This.SelStart = 0

DESABILITAR A CAIXA DE TEXTO DE UM SPINNER

no Evento KEYPRESS, coloque :
Código:
NODEFAULT

SABER SE PROGRAMA ESTA SENDO EXECUTADO A PARTIR DO EXE OU NO PROJETO

Código:
CODE

Código:
IF VERSION(2) = 0 && RunTime
MESSAGEBOX("EXECUTÁVEL")
ELSE
MESSAGEBOX("DESENVOLVIMENTO")
ENDIF

SINCRONIZAR HORARIO COM O SERVIDOR

Há várias maneiras de se fazer isso, aí vai uma delas:

Código:
tcserver = "\\ServidorNt"
_cTextBat = GETENV("TEMP")+"\"+SUBSTR(SYS(2015), 3, 8)+".bat"
_cTextShell = "NET TIME "+tcserver+" /SET /Y"
STRTOFILE(_cTextShell, _cTextBa)

DECLARE LONG WinExec;
    IN KERNEL32;
    STRING lpCmdLine, LONG nCmdShow
winexec(_cTextBat, 0)
=INKEY(.2, "H")

CONTROLAR SAÍDA DO BROWSE

Algumas pessoas ainda não estão totalmente acostumadas ao uso de Grids, então vai uma dica antiga, para se fechar a tela do BROWSE com a tecla ENTER:

Código:
ON KEY LABEL ENTER KEYBOARD '{CTRL+W}'
USE suaTabela
BROWSE
ON KEY LABEL ENTER

Outro modo interessante, agora usando a função SYS(18), que retorna o campo em que se estava:

Código:
ON KEY LABEL ENTER do teste
USE clientes
BROWSE
ON KEY LABEL ENTER
RETURN

Código:
PROCEDURE teste
MESSAGEBOX("Campo selecionado :" + SYS(18))
KEYBOARD '{CTRL+W}'
ENDPROC

CONFIRMAÇÃO ANTES DE FECHAR O FORM

O evento QueryUnload é disparado ao se clicar no "X" para fechar um form. Para se evitar que ele seja fechado, basta se colocar NODEFAULT, que o Form volta à execução normal.

Para testar, coloque no evento QueryUnload do seu form :

Código:
IF MESSAGEBOX("Deseja encerrar ?",32+4,"Unload") <> 6 && Sim
  NODEFAULT
ENDIF

GRAVAR EM CD

OBS: Funciona somente no Windows XP

Código:
oShell = Createobject("wscript.shell")
lnRet = oShell.Run(FULLPATH("CreateCD.exe") + " " + lcParam ,1, .T.)

IMPRIMIR ARQUIVO DIRETAMETE NA IMPRESSORA

Código:
DECLARE INTEGER ShellExecute IN SHELL32.DLL;
  INTEGER nWinHandle,;
        STRING cOperation,;
        STRING cFileName,;
        STRING cParameters,;
        STRING cDirectory,;
        INTEGER nShowWindow
ShellExecute(0, 'print', [MeuArquivo.xxx], '', '', 1)

INTERROMPER PROCESSO

O exemplo abaixo mostra uma das possíveis técnicas que pode ser usada para se interromper um processo, que pode estar dentro de um LOOP, SCAN, etc.

Código:
oForm = CREATEOBJECT([Form1])
oForm.SHOW(1)

DEFINE CLASS form1 AS FORM

  DOCREATE = .T.
  bcancelloop = .F.
  NAME = "form1"
  ADD OBJECT command1 AS COMMANDBUTTON WITH;
    TOP = 125,;
    LEFT = 8,;
    HEIGHT = 27,;
    WIDTH = 111,;
    CAPTION = "Start Loop",;
    NAME = "Command1"

  ADD OBJECT command2 AS COMMANDBUTTON WITH;
    TOP = 125,;
    LEFT = 130,;
    HEIGHT = 27,;
    WIDTH = 111,;
    CAPTION = "Cancel Loop",;
    NAME = "Command2"

  ADD OBJECT label1 AS LABEL WITH;
    AUTOSIZE = .T.,;
    CAPTION = "Press START",;
    HEIGHT = 17,;
    LEFT = 31,;
    TOP = 45,;
    WIDTH = 40,;
    NAME = "Label1"

  PROCEDURE command1.CLICK
  THISFORM.bcancelloop = .F.
  lnCounter = 0
  DO WHILE .T.
    lnCounter = lnCounter + 1
    THISFORM.label1.CAPTION = TRANSFORM(lnCounter)
    DOEVENTS
    IF THISFORM.bcancelloop
      THISFORM.label1.CAPTION = [Loop is canceled]
      EXIT
    ENDIF
  ENDDO

  ENDPROC

  PROCEDURE command2.CLICK
  THISFORM.bcancelloop = .T.
  ENDPROC

ENDDEFINE
avatar
alceu11
Usuário 5 Estrelas
Usuário 5 Estrelas


Voltar ao Topo Ir em baixo

Astúcia Re: Estas funcoes sao muito interessantes mesmo leiam!!!

Mensagem por Marcos Guedes em 30/12/2009, 09:59

Ótimos códigos, Alceu!

Obrigado por compartilhar!

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Astúcia Re: Estas funcoes sao muito interessantes mesmo leiam!!!

Mensagem por Nelson Arcas em 30/12/2009, 10:15

Alceu
Muito interessante e funcional mesmo as dicas!!!

Valeu por compartilhar com todos!!
avatar
Nelson Arcas
Participa Bastante
Participa Bastante


Voltar ao Topo Ir em baixo

Astúcia Re: Estas funcoes sao muito interessantes mesmo leiam!!!

Mensagem por alceu11 em 31/12/2009, 00:37

MAIS UNS TRUQUES NO VFP
LINK PARA BAIXAR, COMO ESTA ZIPADO E UM ARQUIVO DOC
MARCOS SE TU QUISER COLOCAR, AQUI FIQUE A VONTADE
[Você precisa estar registrado e conectado para ver este link.]
avatar
alceu11
Usuário 5 Estrelas
Usuário 5 Estrelas


Voltar ao Topo Ir em baixo

Astúcia Re: Estas funcoes sao muito interessantes mesmo leiam!!!

Mensagem por alceu11 em 31/12/2009, 06:50

Marcos agora que reparei que tu me deu um obrigado valeu hein
vai chover cheers
mais as dicas sao otimas,

Postei hoje 1,30hs mais truques, esta em espanhol, mais nada como pegar o tratudor do google e trazer para nossa lingua portuguesa, Very Happy Very Happy
Espero que goste. cheers
Te de o topico apostilas do fox, iria despejar, 35 apostilas no forum,
Sei que nao vou durar para sempre, gostaria deixar todas as apostilas que tenho.
avatar
alceu11
Usuário 5 Estrelas
Usuário 5 Estrelas


Voltar ao Topo Ir em baixo

Astúcia Re: Estas funcoes sao muito interessantes mesmo leiam!!!

Mensagem por Marcos Guedes em 31/12/2009, 07:06

[Você precisa estar registrado e conectado para ver este link.] escreveu:Te de o topico apostilas do fox, iria despejar, 35 apostilas no forum,
Sei que nao vou durar para sempre, gostaria deixar todas as apostilas que tenho.
Alceu, as apostilas certamente serão de grande enriquecimento para o fórum, porém vale lembrar que, se você tiver referências do autor(es) das apostilas, favor postar para evitar problemas futuramente.

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Astúcia Re: Estas funcoes sao muito interessantes mesmo leiam!!!

Mensagem por alceu11 em 31/12/2009, 07:18

puts grilos coloquei mais dicas tu arruma ai saiu errado Very Happy
avatar
alceu11
Usuário 5 Estrelas
Usuário 5 Estrelas


Voltar ao Topo Ir em baixo

Astúcia Re: Estas funcoes sao muito interessantes mesmo leiam!!!

Mensagem por Marcos Guedes em 31/12/2009, 07:25

[Você precisa estar registrado e conectado para ver este link.] escreveu:puts grilos coloquei mais dicas tu arruma ai saiu errado Very Happy
Blz!
Depois jutarei estas dicas e as demais, ao tópico único de Dicas e Truques e funções interessantes!

_________________
Marcos Guedes - Programador e desenvolvedor Web.


Visite o nosso portal:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo


 
Permissão deste fórum:
Você não pode responder aos tópicos neste fórum