Ir para conteúdo

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

felisbino

Dicas gerais Pra V.Foxpro

Por , em Algoritmos & Outras Tecnologias

Recommended Posts

felisbino    0

felisbino
Postado

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.

http://www.sintegra.gov.br/DLL3.zip

Salve em qualquer pasta, de preferência em ..\WINDOWS\SYSTEM

 

Usá-la é bastante simples :

 

Primeiramente, é preciso "declarar" a DLL

 

Declare Integer ConsisteInscricaoEstadual In DllInscE32.DLL String, String

 

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

 

*-------------------------------------------------------------
* 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.

 

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 

*------------------------------------------------------------
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
* ------------------------
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
* ------------------------
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

 

*------------------------------------------------------------
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
* --------------------
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
* --------------------
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() : 

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: www.foxbrasil.com.br

Marque a propriedade FontUnderline como .T.

 

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

 

oIE = CREATEOBJECT("InternetExplorer.Application")
oIE.Navigate(This.Caption)
oIE.Visible = .T.

ou então :

 

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

append from nome_do_arquivo.xls ou txt type xls ou txt
Exportar

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.

 

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:

 

 

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:

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, _cTextBat)

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


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

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.

 

 

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

Muito LEGAL NÃO

 

AQUI TEM ALGUNS SITES

 

FoxBrasil

The SPS Weblog

GOFOXPRO

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos Algoritmos & Outras Tecnologias
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito