Usamos cookies para medir audiência e melhorar sua experiência. Você pode aceitar ou recusar a qualquer momento. Veja sobre o iMasters.
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:
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
Carregando comentários...