Clique abaixo para nos ajudar
Login

Esqueci minha senha

Estamos no Facebook
Buscar
 
 

Resultados por:
 


Rechercher Busca avançada

Quem está conectado
30 usuários online :: Nenhum usuário registrado, Nenhum Invisível e 30 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
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

Tudo dá errado

3/2/2017, 16:50 por Douglas Pascini

Troquei de maquina, achei que seria uma boa, [Você precisa estar registrado e conectado para ver esta imagem.]  pois passei para uma maquina melhor.

Instalei o …

Comentários: 1

URGENTE - Instalação do aplicativo

24/1/2017, 08:51 por Douglas Pascini

Bom dia. Estou com um problema, ao fazer a instalação (colocar os arquivo) do aplicativo na …

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: 3

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

Os nossos membros postaram um total de 21 mensagens em 12 assuntos

[Tópico Único] - Dicas e Truques

Página 1 de 2 1, 2  Seguinte

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

Anexo [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 22/5/2009, 12:13

Manipulando Formulários:
Código:
DO FORM "seuForm.scx" NAME formAberto

formAberto.WindowState = 1 && Minimza a janela
formAberto.WindowState = 0 && Restaura a janela
formAberto.show() && Traz para frente
formAberto.Release() && Fecha o Form


Última edição por Marcos Guedes em 21/7/2010, 16:17, editado 3 vez(es)

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Anexo [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 9/7/2009, 00:21

Rodando a aplicação a partir de sua pasta de instalação:
Código:
SET DEFAULT TO (ADDBS(JUSTPATH(SYS(16,0))))


Última edição por Marcos Guedes em 8/9/2009, 09:35, editado 4 vez(es)

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 17/7/2009, 10:52

Colorindo itens numa Grid:

Segue um exemplo colorindo itens marcados/deletados (Neste caso é necessário que a aplicação esteja com o SET DELETED OFF).
Colocar o código abaixo no INIT do formulário que contém a GRID:
Código:
LOCAL coluna as Column

FOR EACH m.coluna IN this.nomeDaGRID.Columns
   *!* Se eu quizer alguma cor para o fundo
   m.coluna.DynamicBackColor = "IIF(DELETED(),RGB(255,255,213),rgb(255,255,255))"
   *!* Se eu quizer alguma cor para a letra
   m.coluna.DynamicForeColor = "IIF(DELETED(),RGB(255,0,0),rgb(0,0,0))"
ENDFOR


Última edição por Marcos Guedes em 18/7/2009, 12:03, editado 1 vez(es) (Razão : Retirei uma variável que não estava sendo utilizada.)

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 17/7/2009, 23:50

Utilizando "m." em variáveis:

Existe uma grande importância em acrescentar o "m." como prefixo em uma variável!
Quando fazemos algo do tipo:
Código:
MESSAGEBOX(campo1)
O VFP, antes de mais nada, verifica se há alguma tabela/cursor selecionado, e se o(a) mesmo(a) tem um campo chamado "campo1", sendo assim ele retorna o valor do campo "campo1", em caso contrário, ele retorna o valor da variável "campo1".
Quando colocamos o "m.", estamos informado ao fox que estamos tratando de uma variável e não de um campo, logo o fox não verificará se alguma tabela está aberta, para depois nos retornar o valor da variável.

O seguinte exemplo tentará esclarecer a dica:
Código:
CREATE CURSOR TESTE (campo1 C(14))
INSERT INTO TESTE VALUES ("Valor do Campo")

LOCAL campo1 AS INTEGER
*!* Neste caso eu atribuiria valores da seguinte forma:
*!* m.campo1 = "Este é o valor de uma variável"
*!* Mas a forma abaixo também é válida!
campo1 = "Este é o valor de uma variável"

SELECT "TESTE"
MESSAGEBOX(campo1) && Campo do cursor
MESSAGEBOX(m.campo1) && Variável

USE IN SELECT("teste")

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 23/7/2009, 13:34

Formulário redondo:
Código:
PUBLIC oform
oform = CREATEOBJECT("Tform")
oform.VISIBLE = .T.
* end of main

DEFINE CLASS tform AS FORM

   #DEFINE badgediameter 500
   #DEFINE topmargin 1
   #DEFINE leftmargin 2

   WIDTH=500
   HEIGHT=500
   AUTOCENTER=.T.
   DESKTOP=.T.
   SHOWWINDOW = 2
   PICTURE="fundo.jpg"
   hrgn=0

   ADD OBJECT lbl AS LABEL WITH CAPTION="Senha:",;
      FONTNAME="Arial", FONTSIZE=9, bold=.T., BACKSTYLE=0, ALIGNMENT=2,;
      FORECOLOR=RGB(255,255,225), LEFT=384, TOP=214, WIDTH=100, HEIGHT=25;

   ADD OBJECT txt AS TEXTBOX WITH WIDTH=100, HEIGHT=24,;
      LEFT=382, TOP=230, FORECOLOR=RGB(128,128,128),PASSWORDCHAR="X"

   ADD OBJECT cmd AS COMMANDBUTTON WITH WIDTH=40, HEIGHT=25,;
      LEFT=384, TOP=265, CAPTION="Ok", DEFAULT=.T.

   ADD OBJECT fxform AS COMMANDBUTTON WITH WIDTH=55, HEIGHT=25,;
      LEFT=430, TOP=265, CAPTION="Fechar", DEFAULT=.T.

   PROCEDURE INIT
      *
      DO DECL
   ENDPROC

   PROCEDURE ACTIVATE
      *
      IF THIS.hrgn = 0
         THIS.regionon
      ENDIF
   ENDPROC

   PROCEDURE regionon
      #DEFINE sm_cysize 31
      #DEFINE sm_cxframe 32
      #DEFINE sm_cyframe 33
      LOCAL HWND, x0, y0, x1, y1

      * calculating position of the region
      x0 = getsystemmetrics(sm_cxframe) + leftmargin
      y0 = getsystemmetrics(sm_cysize) +;
         getsystemmetrics(sm_cyframe) + topmargin
      x1 = x0 + badgediameter
      y1 = y0 + badgediameter

      * creating an elliptical region
      THIS.hrgn = createellipticrgn (x0, y0, x1, y1)
      HWND = getfocus()

      * applying the region to the form
      IF setwindowrgn(HWND, THIS.hrgn, 1) = 0
         * if failed then release the handle
         = deleteobject (THIS.hrgn)
         THIS.hrgn = 0
      ENDIF
   ENDPROC

   PROCEDURE MOUSEDOWN
      LPARAMETERS nbutton, nshift, nxcoord, nycoord
      #DEFINE wm_syscommand 0x112
      #DEFINE wm_lbuttonup 0x202
      #DEFINE mouse_move 0xf012
      IF nbutton = 1
         LOCAL hwindow
         hwindow = getfocus()
         = releasecapture()
         = sendmessage(hwindow, wm_syscommand, mouse_move, 0)
         = sendmessage(hwindow, wm_lbuttonup, 0, 0)
      ENDIF
   ENDPROC

   PROCEDURE cmd.CLICK

      WITH THISFORM
         IF EMPTY(.txt.VALUE)
            .txt.SETFOCUS
            MESSAGEBOX(" Preenchimento obrigatório !",64+0+0,"Atenção")
            RETURN .F.
         ENDIF
         IF .txt.VALUE # '12345'
            =MESSAGEBOX('Senha "'+(ALLTRIM(.txt.VALUE))+'" é inválida !',24+0+0,'Atenção')
            .txt.SETFOCUS
            RETURN .F.
         ELSE
            tudo_ok = .T.
            DODEFAULT()
         ENDIF
      ENDWITH

      THISFORM.RELEASE
   ENDPROC

   PROCEDURE fxform.CLICK
      THISFORM.RELEASE
   ENDPROC

ENDDEFINE

PROCEDURE DECL
   DECLARE INTEGER GetFocus IN user32
   DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject
   DECLARE INTEGER GetSystemMetrics IN user32 INTEGER nIndex
   DECLARE INTEGER ReleaseCapture IN user32

   DECLARE INTEGER SendMessage IN user32;
      INTEGER HWND, INTEGER Msg,;
      INTEGER wParam, INTEGER LPARAM

   DECLARE INTEGER CreateEllipticRgn IN gdi32;
      INTEGER nLeftRect, INTEGER nTopRect,;
      INTEGER nRightRect, INTEGER nBottomRect

   DECLARE INTEGER SetWindowRgn IN user32;
      INTEGER HWND, INTEGER hRgn, INTEGER bRedraw
ENDPROC

Fonte original:
[Você precisa estar registrado e conectado para ver este link.]

Marcos Guedes
Webmaster
Webmaster


Voltar ao Topo Ir em baixo

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 5/8/2009, 15:47

Encontrei esta função no Help do fox e achei interessante compartilhar com os colegas.
Muitas respostas que alcançamos com várias linhas de códigos, podemos resumir a esta simples função GETENV()
Código:
?"Nome do computador: "
?? GETENV("COMPUTERNAME")

?"Drive primário: "
?? GETENV("HOMEDRIVE")

?"Pasta do usuário: "
?? GETENV("HOMEPATH")

?"Número de processos: "
?? GETENV("NUMBER_OF_PROCESSORS")

?"Sistema Operacional: "
?? GETENV("OS")

?"Processador: "
?? GETENV("PROCESSOR_IDENTIFIER")

?"Pasta arquivos de programas: "
?? GETENV("ProgramFiles")

?"Sessão: "
?? GETENV("SESSIONNAME")

?"Driver do sistema: "
?? GETENV("SystemDrive")

?"Pasta temporária(TEMP): "
?? GETENV("TEMP")

?"Pasta temporária(TMP): "
?? GETENV("TMP")

?"Nome do usuário: "
?? GETENV("USERNAME")

?"Pasta do usuário: "
?? GETENV("USERPROFILE")

?"Diretório do Windows: "
?? GETENV("windir")

?
*!* Outros exemplos:
? GETENV("ALLUSERSPROFILE")
? GETENV("APPDATA")
? GETENV("CommonProgramFiles")
? GETENV("ComSpec")
? GETENV("FP_NO_HOST_CHECK")
? GETENV("LOCALAPPDATA")
? GETENV("LOGONSERVER")
? GETENV("Path")
? GETENV("PATHEXT")
? GETENV("PROCESSOR_ARCHITECTURE")
? GETENV("PROCESSOR_LEVEL")
? GETENV("PROCESSOR_REVISION")
? GETENV("ProgramData")
? GETENV("PUBLIC")
? GETENV("SystemRoot")
? GETENV("USERDOMAIN")
? GETENV("VS90COMNTOOLS")

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 6/8/2009, 22:26

Abrindo o painel de controle de data e hora do windows:
Código:
Run /N Control Timedate.cpl

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 6/8/2009, 22:35

Alterando a propriedade de vários objetos de uma única vez:
Código:
thisform.SetAll("readonly", .f., "Textbox")
Nota: O exemplo torna todos os textbox's de um form com a propriedade READONLY = .F.

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 6/8/2009, 22:42

Utilizando o DOEVENTS para dar continuidades a processos:
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
Autor: Borislav Borissov


Última edição por Marcos Guedes em 8/8/2009, 10:21, editado 1 vez(es)

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 6/8/2009, 22:56

Centralizar imagem no SCREEN do fox:
Código:
_screen.AddObject("LOGO","Image")
_screen.LOGO.Picture=GETPICT()
_screen.LOGO.left=(_Screen.width/2) - (_screen.LOGO.width/2)
_screen.LOGO.Top =(_Screen.Height/2) - (_screen.LOGO.Height/2)
_screen.LOGO.BackStyle = 0 && Transparente
_screen.LOGO.Visible = .T.

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 7/8/2009, 07:55

Verificando se um objeto tem, ou não, uma propriedade:
Código:
CLEAR

LOCAL obj as Object
m.obj = NEWOBJECT("classeteste")

?PEMSTATUS(m.obj, 'prop1',5)
?PEMSTATUS(m.obj, 'prop3',5)
?PEMSTATUS(m.obj, 'modelo1',5)
?PEMSTATUS(m.obj, 'modelo3',5)

m.obj = null

DEFINE CLASS classeteste AS CUSTOM

   prop1 = NULL
   prop2 = NULL

   PROCEDURE modelo1 AS void
   ENDPROC

   PROCEDURE modelo2 AS void
   ENDPROC

ENDDEFINE

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 13/8/2009, 17:11

Separando as cores de um resultado obtidas pela função GETCOLOR():
Código:
CLEAR
lncor = GETCOLOR()

?getred(lncor)
?getgreen(lncor)
?getblue(lncor)

FUNCTION getred(tncolor)
   RETURN BITAND(tncolor, 0x000000ff)
ENDFUNC

FUNCTION getgreen(tncolor)
   RETURN BITRSHIFT(BITAND(tncolor, 0x0000ff00), 8)
ENDFUNC

FUNCTION getblue(tncolor)
   RETURN BITRSHIFT(BITAND(tncolor, 0x00ff0000), 16)
ENDFUNC

Fonte:
Grupo Fox Br, postado por Thiago Takehana.

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 14/8/2009, 14:24

Manipulando Formulários:
Código:
DO FORM "seuForm.scx" NAME formAberto

formAberto.WindowState = 1 && Minimza a janela
formAberto.WindowState = 0 && Restaura a janela
formAberto.show() && Traz para frente
formAberto.Release() && Fecha o Form

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 9/9/2009, 17:45

Escolhendo o papel para impressão:
Código:
SYS(1037)

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 9/9/2009, 17:46

Exemplo de impressão utilizando o "@... SAY":
Código:
SET DEVICE TO PRINTER
SET PRINTER ON

@ PROW(), PCOL() SAY "Linha 1"
@ PROW()+1, 0 SAY "Linha 2"
@ PROW()+1, 0 SAY "Linha 3"

SET PRINTER OFF
SET PRINTER TO
SET DEVICE TO SCREEN

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 11/9/2009, 15:44

Adicionando uma imagem à SCREEN (Ocupando o espaço todo!):
Código:
_SCREEN.ADDOBJECT("LOGO","Image")
_SCREEN.LOGO.PICTURE=GETPICT()
_SCREEN.LOGO.LEFT=0
_SCREEN.LOGO.TOP =0
_SCREEN.LOGO.BACKSTYLE = 0 && Transparente
_SCREEN.LOGO.STRETCH = 2
_SCREEN.LOGO.VISIBLE = .T.
_SCREEN.LOGO.WIDTH = _SCREEN.WIDTH
_SCREEN.LOGO.HEIGHT = _SCREEN.HEIGHT

PUBLIC ohandler
ohandler=NEWOBJECT("myhandler")

BINDEVENT(_SCREEN,"Resize",ohandler,"myresize")

DEFINE CLASS myhandler AS SESSION

   PROCEDURE myresize
      _SCREEN.LOGO.WIDTH = _SCREEN.WIDTH
      _SCREEN.LOGO.HEIGHT = _SCREEN.HEIGHT

   ENDPROC

ENDDEFINE

Obs: Muito cuidado para não utilizar um objeto público com o nome "ohandler". Pois o mesmo está sendo utilizado por esta função!

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 12/9/2009, 12:16

Exibindo um menu com opções Copiar, Recortar e Colar
Código:
PARAMETER oref

DEFINE POPUP edtshort FROM MROW(), MCOL() RELATIVE shortcut
DEFINE BAR _MED_COPY OF edtshort PROMPT "Copiar" KEY ctrl+c, "Ctrl+C"
DEFINE BAR _MED_CUT OF edtshort PROMPT "Recortar" KEY ctrl+x, "Ctrl+X"
DEFINE BAR 1 OF edtshort PROMPT "\-"
DEFINE BAR _MED_PASTE OF edtshort PROMPT "Colar" KEY ctrl+v, "Ctrl+V"

ACTIVATE POPUP edtshort

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 17/10/2009, 11:14

Colorindo linhas de um Grid:

Coloque o código seguinte no método INI de seu formulário:
Código:
this.seuGrid.SetAll("DynamicBackColor", "IIF(MOD(RECNO(), 2)=0, RGB(255,255,255), RGB(225,240,255))")

Obs: Altere "seuGrid" para o nome de seu controle Grid o qual desejas colorir.

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 19/10/2009, 09:15

Desabilitar opção no combobox:

Para desabilitar um item existente em um combobox, adicione o caracter "\" (Sem aspas!) à descrição do item.
Ex:
Código:
1. THISFORM.seuCombo.ADDLISTITEM("Opção 1")
2. THISFORM.seuCombo.ADDLISTITEM("Opção 2")
3. THISFORM.seuCombo.ADDLISTITEM("\Desabilitado")
4. THISFORM.seuCombo.ADDLISTITEM("Opção 4")
5. THISFORM.seuCombo.ADDLISTITEM("Opção 5")
Nota: Observe que a opção 3 no combobox estará desabilitada.

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 29/10/2009, 10:38

Verificar se o usuário logado é adminitrador:
Código:
DECLARE INTEGER IsUserAnAdmin IN shell32
?(IsUserAnAdmin()=1)

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 1/12/2009, 10:58

Utilizando o WebBrowser a partir de um PRG:
Código:
LOCAL oform AS FORM
*!*
m.oform = NEWOBJECT("ShellExplorer")
m.oform.SHOW()
*!*
READ EVENTS
*!*
m.oform = NULL
*!*
DEFINE CLASS shellexplorer AS FORM
   *!*
   CAPTION = "Shell Explorer"
   SHOWWINDOW = 2
   AUTOCENTER = .T.
   WIDTH = 800
   HEIGHT = 600
   *!*
   ADD OBJECT _webbrowser41 AS OLECONTROL WITH ;
      TOP = 0,;
      LEFT = 0,;
      WIDTH = THIS.WIDTH,;
      HEIGHT = THIS.HEIGHT,;
      ANCHOR =15,;
      OLECLASS = "Shell.Explorer"
   *!*
   PROCEDURE DESTROY AS void
      CLEAR EVENTS
   ENDPROC
   *!*
   PROCEDURE _webbrowser41.REFRESH
      NODEFAULT
   ENDPROC
   *!*
   PROCEDURE INIT
      THISFORM._webbrowser41.navigate2("http://www.google.com")
   ENDPROC
   *!*
ENDDEFINE

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 10/12/2009, 11:19

Iniciando a janela de mapeamento de rede:
Código:
#DEFINE resourcetype_disk  1
#DEFINE resourcetype_print  2

DO DECL

LOCAL hwindow
hwindow = getactivewindow()

* Map Network Drive dialog box
= wnetconnectiondialog(hwindow, resourcetype_disk)

* Disconnect Network Drives dialog box
* only RESOURCETYPE_DISK flag is allowed
= wnetdisconnectdialog(hwindow, resourcetype_disk)

PROCEDURE DECL
   DECLARE INTEGER GetActiveWindow IN user32

   DECLARE INTEGER WNetConnectionDialog IN mpr;
      INTEGER HWND, INTEGER dwType

   DECLARE INTEGER WNetDisconnectDialog IN mpr;
      INTEGER HWND, INTEGER dwType
ENDPROC
Fonte:
[Você precisa estar registrado e conectado para ver este link.]

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 10/12/2009, 11:30

Arrastando arquivos para um formulário:
Código:
LOCAL oform AS tform
oform = CREATEOBJECT("TForm")
oform.VISIBLE=.T.
READ EVENTS
* end of main

DEFINE CLASS tform AS FORM
   #DEFINE wm_dropfiles 0x0233
   #DEFINE gwl_wndproc -4
   #DEFINE max_path 260

   PROTECTED hwindow, horigproc
   hwindow=0
   horigproc=0
   WIDTH=350
   HEIGHT=200
   MINBUTTON=.F.
   MAXBUTTON=.F.
   CAPTION=" Dropping files on the form"
   SHOWWINDOW=2
   AUTOCENTER=.T.

   ADD OBJECT ch AS CHECKBOX WITH;
      LEFT=10, TOP=10, AUTOSIZE=.T., BACKSTYLE=0,;
      CAPTION="Accept dropped files", VALUE=0

   ADD OBJECT lst AS LISTBOX WITH;
      LEFT=5, TOP=40, WIDTH=340, HEIGHT=130

   ADD OBJECT lbl AS LABEL WITH;
      LEFT=10, TOP=176, AUTOSIZE=.T., BACKSTYLE=0,;
      CAPTION="Drag files from an Explorer window and drop on the listbox"

   PROCEDURE INIT
      THIS.DECLARE
   ENDPROC

   PROCEDURE DESTROY
      THIS.releaseaccept
      CLEAR EVENTS
   ENDPROC

   PROCEDURE ch.INTERACTIVECHANGE
      IF THIS.VALUE = 1
         THISFORM.setaccept
      ELSE
         THISFORM.releaseaccept
      ENDIF
   ENDPROC

   PROCEDURE setaccept
      THIS.hwindow = getfocus()
      THIS.horigproc = getwindowlong(THIS.hwindow, gwl_wndproc)

      IF VERSION(5) >= 900
         = BINDEVENT(THIS.hwindow, wm_dropfiles,;
            THIS, "OnFilesDropped")
      ENDIF
      = dragacceptfiles(THIS.hwindow, 1)
   ENDPROC

   PROCEDURE releaseaccept
      = UNBINDEVENTS(THIS)

      IF THIS.hwindow <> 0
         = dragacceptfiles(THIS.hwindow, 0)
         THIS.hwindow=0
      ENDIF
   ENDPROC

   PROCEDURE onfilesdropped(hwindow AS INTEGER,;
         nmsgid AS INTEGER, wparam AS INTEGER, LPARAM AS INTEGER)
      * requires VFP9, otherwise ignored
      * note that input parameters are predefined and should not be changed
      * see WindowProc function for details

      LOCAL nreturn
      nreturn=0

      DO CASE
         CASE nmsgid=wm_dropfiles
            THIS.processdroppedfiles(wparam)

         OTHERWISE
            * pass control to the original window procedure
            nreturn = callwindowproc(THIS.horigproc, THIS.hwindow,;
               m.nmsgid, m.wparam, m.lparam)
      ENDCASE
      RETURN nreturn

   PROTECTED PROCEDURE processdroppedfiles(hdrop)
      LOCAL cpoint, nx, ny
      cpoint = REPLICATE(CHR(0),8)  && POINT buffer
      = dragquerypoint(hdrop, @cpoint)
      nx = buf2dword(SUBSTR(cpoint,1,4))
      ny = buf2dword(SUBSTR(cpoint,5,4))

      * only if clicked inside the listbox
      WITH THIS.lst
         IF NOT (BETWEEN(nx, .LEFT, .LEFT+.WIDTH-1);
               AND BETWEEN(ny, .TOP, .TOP+.HEIGHT-1))
            RETURN
            = dragfinish(hdrop)
         ENDIF
      ENDWITH

      THIS.lst.CLEAR

      LOCAL nfilecount, nindex, cbuffer, nlength
      nfilecount = dragqueryfile(hdrop, 0xffffffff, NULL, 0)

      FOR nindex=0 TO nfilecount-1
         cbuffer = REPLICATE(CHR(0), max_path)
         nlength = dragqueryfile(hdrop, nindex, @cbuffer, max_path)
         cbuffer = SUBSTR(cbuffer, 1, nlength)
         THIS.lst.ADDITEM(cbuffer)
      NEXT

      = dragfinish(hdrop)
   ENDPROC

   PROTECTED PROCEDURE DECLARE
      DECLARE INTEGER GetFocus IN user32
      DECLARE DragFinish IN shell32 INTEGER hDrop

      DECLARE DragAcceptFiles IN Shell32;
         INTEGER hWindow, INTEGER fAccept

      DECLARE INTEGER DragQueryFile IN shell32;
         INTEGER hDrop, INTEGER iFile,;
         STRING @lpszFile, INTEGER cch

      DECLARE INTEGER DragQueryPoint IN shell32;
         INTEGER hDrop, STRING @lppt

      DECLARE INTEGER CallWindowProc IN user32;
         INTEGER lpPrevWndFunc, INTEGER hWindow, LONG Msg,;
         INTEGER wParam, INTEGER LPARAM

      DECLARE INTEGER GetWindowLong IN user32;
         INTEGER hWindow, INTEGER nIndex
   ENDPROC

ENDDEFINE

FUNCTION buf2dword(lcbuffer)
   RETURN ASC(SUBSTR(lcbuffer, 1,1)) + ;
      BITLSHIFT(ASC(SUBSTR(lcbuffer, 2,1)),  8) +;
      BITLSHIFT(ASC(SUBSTR(lcbuffer, 3,1)), 16) +;
      BITLSHIFT(ASC(SUBSTR(lcbuffer, 4,1)), 24)
ENDFUNC
Fonte:
[Você precisa estar registrado e conectado para ver este link.]

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 10/12/2009, 11:35

Limitando a área de seleção do mouse:
Código:
PUBLIC frm
frm = CREATEOBJECT("TForm")
frm.VISIBLE = .T.

DEFINE CLASS tform AS FORM
   PROTECTED mclip
   MAXBUTTON=.F.
   MINBUTTON=.F.
   WIDTH=500
   HEIGHT=250
   CAPTION = "Clipping mouse cursor area"
   BORDERSTYLE=2
   AUTOCENTER=.T.

   ADD OBJECT cmdclip AS tcommand WITH CAPTION="Clip"
   ADD OBJECT cmdrestore AS tcommand WITH CAPTION="Restore"

   PROCEDURE INIT
      THIS.DECLARE
      * save initial clipping area
      lprect = REPLICATE(CHR(0), 16)
      = getclipcursor(@lprect)
      THIS.mclip = m.lprect
      THIS.RESIZE

   PROCEDURE DESTROY
      THIS.restoreinitstatus

   PROCEDURE RESIZE
      lntop = MAX(5, THIS.HEIGHT - THIS.cmdclip.HEIGHT - 5)
      STORE lntop TO THIS.cmdclip.TOP, THIS.cmdrestore.TOP
      THIS.cmdrestore.LEFT = THIS.WIDTH - THIS.cmdrestore.WIDTH - 10
      THIS.cmdclip.LEFT = THIS.cmdrestore.LEFT - THIS.cmdclip.WIDTH - 2

   PROCEDURE CLIP
      * locks the cursor inside the form
      MOUSE AT THIS.TOP, THIS.LEFT PIXELS  && put cursor inside the form
      * give VFP a time slice for updating mouse position in its internal data
      = INKEY(0.1)

      lppoint = REPLICATE(CHR(0), 8)    && allocate space for POINT structure
      = getcursorpos(@lppoint)  && retrieve absolute mouse position

      LOCAL absx, absy, lccaptionheight, lcframewidth,;
         lcframeheight, lcrect

      absx = THISFORM.buf2dword(SUBSTR(lppoint, 1,4))
      absy = THISFORM.buf2dword(SUBSTR(lppoint, 5,4))

      * retrieve some sizes to be used in calculating the area
      lccaptionheight=getsystemmetrics(4)  && size of normal caption area
      lcframewidth=getsystemmetrics(32)  && resiz.window frame width
      lcframeheight=getsystemmetrics(33)  && resiz.window frame height

      lcrect = REPLI(CHR(0), 16)    && allocate space for RECT structure
      * resize the RECT using the form position, and size
      THIS.num2rect(absx, absy, absx + THIS.WIDTH + lcframewidth,;
         absy + THIS.HEIGHT + lccaptionheight + lcframeheight, @lcrect)

      = clipcursor(lcrect)  && locked!

   PROCEDURE restoreinitstatus
      = clipcursor(THIS.mclip)

   PROCEDURE cmdclip.CLICK
      THISFORM.CLIP

   PROCEDURE cmdrestore.CLICK
      THISFORM.restoreinitstatus

   FUNCTION buf2dword(cbuffer)
      RETURN ASC(SUBSTR(cbuffer, 1,1)) + ;
         BITLSHIFT(ASC(SUBSTR(cbuffer, 2,1)),  8) +;
         BITLSHIFT(ASC(SUBSTR(cbuffer, 3,1)), 16) +;
         BITLSHIFT(ASC(SUBSTR(cbuffer, 4,1)), 24)

   FUNCTION num2dword(lnvalue)
      #DEFINE m0 0x0000100
      #DEFINE m1 0x0010000
      #DEFINE m2 0x1000000
      IF lnvalue < 0
         lnvalue = 0x100000000 + lnvalue
      ENDIF
      LOCAL b0, b1, b2, b3
      b3 = INT(lnvalue/m2)
      b2 = INT((lnvalue - b3*m2)/m1)
      b1 = INT((lnvalue - b3*m2 - b2*m1)/m0)
      b0 = MOD(lnvalue, m0)
      RETURN CHR(b0)+CHR(b1)+CHR(b2)+CHR(b3)

   PROCEDURE num2rect(lnleft, lntop, lnright, lnbottom, lcbuffer)
      lcbuffer = THIS.num2dword(lnleft) + THIS.num2dword(lntop)+;
         THIS.num2dword(lnright) + THIS.num2dword(lnbottom)

   PROCEDURE DECLARE
      DECLARE INTEGER ClipCursor IN user32 STRING lpRect
      DECLARE INTEGER GetCursorPos IN user32 STRING @lpPoint
      DECLARE INTEGER GetClipCursor IN user32 STRING @lpRect
      DECLARE INTEGER GetSystemMetrics IN user32 INTEGER nIndex

ENDDEFINE

DEFINE CLASS tcommand AS COMMANDBUTTON
   WIDTH=60
   HEIGHT=25
ENDDEFINE
[Você precisa estar registrado e conectado para ver este link.]

_________________
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

Anexo Re: [Tópico Único] - Dicas e Truques

Mensagem por Marcos Guedes em 11/3/2010, 17:29

Sempre que preciso, esqueço desta função.
Então como lembrete, e dica para quem não conheçe, estou postando aqui.

Retornando o valor sempre positivo:
Código:
?ABS(1)
?ABS(-1)
?ABS(1.5)
?ABS(-1.5)

_________________
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

Página 1 de 2 1, 2  Seguinte

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