Dicas gerais Pra V.Foxpro

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 = wn15+wn24+wn33+wn42+wn59+wn68+wn77+wn86+wn95+wn104+wn113+wn122
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 = wn16+wn25+wn34+wn43+wn52+wn69+wn78+wn87+wn96+wn105+wn114+wn123+
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 = wn110+wn29+wn38+wn47+wn56+wn65+wn74+wn83+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 = wn111+wn210+wn39+wn48+wn57+wn66+wn75+wn84+wn93+wn102
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 txtExportar

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