[Tópico Único] - Dicas e Truques

[Marcos Guedes]

Relembrando a primeira mensagem :

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]

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]

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]

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]

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]

Verificar se o usuário logado é adminitrador:

Código:

DECLARE INTEGER IsUserAnAdmin IN shell32
?(IsUserAnAdmin()=1)

[Marcos Guedes]

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://[Você precisa estar registrado e conectado para ver este link.]
   ENDPROC
   *!*
ENDDEFINE

[Marcos Guedes]

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]

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]

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]

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)

[hugo]

realmente uso pouco mais quando precisamos faz a diferenca!

heheheh

boa

[hugo]

achei legal umas coisinhas aqui

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

[edspicer]

Não sei se o que vou postar esta no topico certo, mas se interessar a alguem ou for relevante, la vai:

Como criar lista de validação no excel com foxpro

Código:

*** Criando lista de validação no excel
.Range("B12").Select
With .Selection.Validation && Lista de Validação
   .Delete
   .Add(3,1,1,"=$Q$12:$Q$20") &&& Range onde será a lista
   .IgnoreBlank = .T.
   .InCellDropdown = .t.
   .InputTitle = "Nome da lista" &&& Legendas
   .ErrorTitle = "Erro!!!"
   .InputMessage = "Selecione um item da lista."
   .ErrorMessage = "Não digite. Selecione um valor da lista."
   .ShowInput = .T. && habilita legendas
   .ShowError = .T.
EndWith
*** Fim Criando lista de validação no excel

Edspicer

[Marcos Guedes]

Reputado!

[hugo]

modo de depuracao

no inicio do codigo digitar:

Código:

acti wind trace
acti wind debug
susp

desta forma voce vai ver seu codigo ser executado passo a passo mediante
pressionar a tela F8

valeu