Clique abaixo para nos ajudar
Login

Esqueci minha senha

Estamos no Facebook
Buscar
 
 

Resultados por:
 


Rechercher Busca avançada

Quem está conectado
13 usuários online :: Nenhum usuário registrado, Nenhum Invisível e 13 Visitantes :: 1 Motor de busca

Nenhum

[ Ver toda a lista ]


O recorde de usuários online foi de 468 em 1/3/2012, 10:43
Últimos assuntos
» Ajuda a direcionar
8/12/2016, 01:17 por miiiih

» Alterar uma palavra num arquivo de texto
5/12/2016, 12:02 por Teseu

» Buscar endereço por CEP
3/12/2016, 19:59 por pedrossian

» USAR WEBSERVICE NO VFP9
2/12/2016, 09:50 por AJC

» BANIMENTO DE USUARIO
17/11/2016, 08:31 por FAF

» Impressora Ticket
15/11/2016, 09:20 por clima238

» Gráfico
9/11/2016, 10:43 por hidroluz

» TRANSPOR TABELA
9/11/2016, 10:34 por hidroluz

» MUDANÇA DO .DBF PARA POTSGREE
9/11/2016, 09:12 por AJC

» Website com videoaulas sobre linguagens de programação
8/11/2016, 09:56 por JLDR

» Parceria para desenvolvimento de template em Wordpress
7/11/2016, 19:15 por mindix

» Data fica invertida na planilha que é gerada via programa.
27/10/2016, 11:00 por Linghston

» Maximizar report direto do menu
21/10/2016, 20:48 por Rosangela Pires

» Fechar form com tempo
21/10/2016, 10:15 por Rosangela Pires

» URGENTE: Ajuda com impressora ELGIN-L42
14/10/2016, 09:53 por megasoft

» Opções para gerar NF-e
10/10/2016, 09:07 por mavsinfo

» Google Maps
8/10/2016, 15:08 por Rosangela Pires

» Mysql
5/10/2016, 11:22 por Marcos Guedes

» Acessando Banco em MYSQL de um projeto WORDPRESS
3/10/2016, 10:58 por Marcos Guedes

» OPTION SELECT MOSTRAR CAMPOS QUASE PRONTO
26/9/2016, 21:09 por BobKuspe

Alterar uma palavra num arquivo de texto

5/12/2016, 12:02 por Teseu

Olá prezados colegas de programação!

Este é eu primeiro post no fórum e gostaria de poder …

Comentários: 0

Buscar endereço por CEP

3/12/2016, 19:59 por pedrossian

Caros amigos, meu código para buscar endereço pelo CEP não funciona mais.
Alguém pode me …

Comentários: 0

USAR WEBSERVICE NO VFP9

2/12/2016, 09:50 por AJC

Pessoal, preciso de um material ou livro que me traga instruções como
usar a consumação de …

Comentários: 0

BANIMENTO DE USUARIO

13/11/2016, 16:21 por FAF

A usuária ROSANGELA PIRES ao tentar acessar o Forum obtem sempre a mensagem de BANIMENTO.
A mesma …

Comentários: 3

Impressora Ticket

15/11/2016, 09:20 por clima238

Bom dia,
Por favor alguém me explique porque o código abaixo imprime no ecrã em vez do printer: …

Comentários: 0

Estatísticas
Temos 6964 usuários registrados
O último usuário registrado atende pelo nome de Ricardo Cassolatto

Os nossos membros postaram um total de 17119 mensagens em 2577 assuntos

Systray

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

Anexo Systray

Mensagem por Marcos Guedes em 15/9/2009, 10:39

Código:
LOCAL oform AS tform
oform = CREATEOBJECT("TForm")
oform.SHOW(1)
* end of main

#DEFINE nim_add 0
#DEFINE nim_modify 1
#DEFINE nim_delete 2
#DEFINE nif_message 1
#DEFINE nif_icon 2
#DEFINE nif_tip 4
#DEFINE notifyicondata_size 88
#DEFINE max_path 260
#DEFINE gwl_wndproc -4
#DEFINE image_icon 1
#DEFINE lr_loadfromfile 0x0010
#DEFINE lr_defaultsize 0x0040

#DEFINE wm_mousemove 0x0200
#DEFINE wm_lbuttondown 0x0201
#DEFINE wm_lbuttonup 0x0202
#DEFINE wm_rbuttondown 0x0204
#DEFINE wm_rbuttonup 0x0205
#DEFINE wm_mbuttondown 0x0207
#DEFINE wm_mbuttonup 0x0208

DEFINE CLASS tform AS FORM
   WIDTH=350
   HEIGHT=200
   BORDERSTYLE=2
   MINBUTTON=.F.
   MAXBUTTON=.F.
   CAPTION="Systray Icon"
   AUTOCENTER=.T.

   ADD OBJECT taskbaricon AS taskbarstatus
   ADD OBJECT sbar AS tbar WITH TOP=398, LEFT=0, HEIGHT=21, WIDTH=685

   ADD OBJECT chshowicon AS CHECKBOX WITH;
      LEFT=15, TOP=15, CAPTION="Show Icon", AUTOSIZE=.T.

   ADD OBJECT cmdloadicon AS COMMANDBUTTON WITH;
      LEFT=120, TOP=10, WIDTH=140, HEIGHT=27,;
      CAPTION="Load Icon from file"

   PROCEDURE chshowicon.CLICK
      THISFORM.showicon(THIS.VALUE)
   ENDPROC

   PROCEDURE cmdloadicon.CLICK
      THISFORM.loadicon
   ENDPROC

   PROCEDURE taskbaricon.onudfmessage
      PARAMETERS wparam AS INTEGER, LPARAM AS INTEGER
      DODEFAULT()

      DO CASE
         CASE LPARAM=wm_mousemove
            THISFORM.sbar.panels(1).TEXT = "Mouse moves: " +;
               TRANS(THIS.lastmousex) + ", " + TRANS(THIS.lastmousey)
         CASE LPARAM=wm_lbuttondown
            THISFORM.sbar.panels(2).TEXT = "Left Button Down"
         CASE LPARAM=wm_lbuttonup
            THISFORM.sbar.panels(2).TEXT = "Left Button Up"
         CASE LPARAM=wm_rbuttondown
            THISFORM.sbar.panels(2).TEXT = "Right Button Down"
         CASE LPARAM=wm_rbuttonup
            THISFORM.sbar.panels(2).TEXT = "Right Button Up"
         CASE LPARAM=wm_mbuttondown
            THISFORM.sbar.panels(2).TEXT = "Middle Button Down"
         CASE LPARAM=wm_mbuttonup
            THISFORM.sbar.panels(2).TEXT = "Middle Button Up"
      ENDCASE
   ENDPROC

   PROCEDURE showicon(nmode)
      * shows or hides icon in the systray
      WITH THIS.taskbaricon
         IF nmode = 0
            .deleteicon
         ELSE
            .baloon = VERSION()
            .initicon(.getdefaulticon())
         ENDIF
      ENDWITH
   ENDPROC

   PROCEDURE loadicon
      * loads icon from a file and displays in the systray
      LOCAL cpath, ciconfile
      cpath = SYS(5) + SYS(2003)
      ciconfile = GETFILE("ico", "Load icon file")
      SET DEFAULT TO (m.cpath)

      IF NOT EMPTY(m.ciconfile)
         THIS.taskbaricon.baloon = LOWER(m.ciconfile)
         THIS.taskbaricon.initicon(m.ciconfile)
         THIS.chshowicon.VALUE=1
      ENDIF
   ENDPROC

ENDDEFINE

DEFINE CLASS tbar AS OLECONTROL
   OLECLASS="MSComctlLib.SBarCtrl.2"

   PROCEDURE INIT
      THIS.HEIGHT=21
      THIS.panels.ADD
      THIS.panels(1).WIDTH = 160
      THIS.panels(2).WIDTH = 700
   ENDPROC
ENDDEFINE

DEFINE CLASS taskbarstatus AS CUSTOM
   hwindow=0
   appid=1
   messageid=0x4001
   horigproc=0
   hicon=0
   baloon=""
   lastmousex=0
   lastmousey=0

   PROCEDURE INIT
      THIS.DECLARE
      THIS.hwindow = _SCREEN.HWND
      THIS.horigproc = getwindowlong(THIS.hwindow, gwl_wndproc)
   ENDPROC

   PROCEDURE DESTROY
      THIS.deleteicon
   ENDPROC

   PROCEDURE deleteicon
      IF THIS.hicon <> 0
         THIS.seticon(nim_delete)
         = destroyicon(THIS.hicon)
         THIS.hicon = 0

         IF VERSION(5) >= 900  && VFP9+
            = UNBINDEVENTS(THIS.hwindow, THIS.messageid)
         ENDIF
      ENDIF
   ENDPROC

   PROCEDURE initicon(hicon)
      THIS.deleteicon

      DO CASE
         CASE VARTYPE(m.hicon)="N"
            THIS.hicon = m.hicon
         CASE VARTYPE(m.hicon)="C"
            THIS.hicon = THIS.loadicon(m.hicon)
         OTHERWISE
            RETURN
      ENDCASE
      THIS.seticon(nim_add)
   ENDPROC

   PROCEDURE seticon(caction)
      LOCAL cbuffer

      cbuffer = num2dword(notifyicondata_size) +;
         num2dword(THIS.hwindow) +;
         num2dword(THIS.appid) +;
         num2dword(nif_icon + nif_message + nif_tip) +;
         num2dword(THIS.messageid) +;
         num2dword(THIS.hicon) +;
         PADR(THIS.baloon, 64, CHR(0))

      IF shell_notifyicon(m.caction, @cbuffer) <> 0
         IF VERSION(5) >= 900  && VFP9+
            = BINDEVENT(THIS.hwindow, THIS.messageid,;
               THIS, "HookedWindowProc")
         ENDIF
      ENDIF
   ENDPROC

   PROCEDURE getmousepos(nx, ny)
      * retrieves position of the cursor in screen coordinates
      LOCAL cbuffer
      cbuffer = REPLICATE(CHR(0), 8)
      = getcursorpos(@cbuffer)
      nx = buf2dword(SUBSTR(cbuffer, 1,4))
      ny = buf2dword(SUBSTR(cbuffer, 5,4))
   ENDPROC

   PROCEDURE loadicon(ciconfile)
      * loads icon from a file
      LOCAL hicon
      TRY
         hicon = loadimage(0, m.ciconfile, image_icon,;
            0,0, lr_loadfromfile+lr_defaultsize)
      CATCH
         hicon=0
      ENDTRY
      RETURN m.hicon
   ENDPROC

   PROCEDURE getdefaulticon
      * loads application icon
      LOCAL cbuffer, nbufsize, niconindex, hicon
      cbuffer = REPLICATE(CHR(0), max_path)
      nbufsize = getmodulefilename (0, @cbuffer, max_path)
      cbuffer = LEFT(cbuffer, nbufsize)
      niconindex = 0  && works as a reference only
      hicon = extractassociatedicon(0, cbuffer, @niconindex)
      RETURN m.hicon
   ENDPROC

   PROCEDURE onudfmessage(wparam AS INTEGER, LPARAM AS INTEGER)
      * you will probably want to subclass this
      LOCAL nx, ny
      STORE 0 TO nx, ny
      THIS.getmousepos(@nx, @ny)
      THIS.lastmousex=m.nx
      THIS.lastmousey=m.ny
   ENDPROC

   PROCEDURE hookedwindowproc(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=THIS.messageid
            THIS.onudfmessage(wparam, LPARAM)

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

   PROTECTED PROCEDURE DECLARE
      DECLARE INTEGER DestroyIcon IN user32 INTEGER hIcon
      DECLARE INTEGER SetForegroundWindow IN user32 INTEGER hWindow
      DECLARE INTEGER GetCursorPos IN user32 STRING @ lpPoint
      DECLARE INTEGER Shell_NotifyIcon IN shell32 INTEGER dwMsg, STRING @lpdata
      DECLARE INTEGER GetWindowLong IN user32 INTEGER hWindow, INTEGER nIndex

      DECLARE INTEGER ExtractAssociatedIcon IN shell32;
         INTEGER hInst, STRING lpIconPath, INTEGER @lpiIcon

      DECLARE INTEGER GetModuleFileName IN kernel32;
         INTEGER hModule, STRING @lpFilename, INTEGER nSize

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

      DECLARE INTEGER LoadImage IN user32;
         INTEGER hinst, STRING lpszName, INTEGER uType,;
         INTEGER cxDesired, INTEGER cyDesired, INTEGER fuLoad
   ENDPROC

ENDDEFINE

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)
ENDFUNC

FUNCTION num2dword(nvalue)
   #DEFINE m0  0x0100
   #DEFINE m1  0x010000
   #DEFINE m2  0x01000000
   IF nvalue < 0
      nvalue = 0x100000000 + nvalue
   ENDIF
   LOCAL b0, b1, b2, b3
   b3 = INT(nvalue/m2)
   b2 = INT((nvalue - b3*m2)/m1)
   b1 = INT((nvalue - b3*m2 - b2*m1)/m0)
   b0 = MOD(nvalue, m0)
   RETURN CHR(b0)+CHR(b1)+CHR(b2)+CHR(b3)
ENDFUNC
Fonte:
news2news.com/vfp/?example=235


Última edição por Marcos Guedes em 4/11/2010, 11:05, 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: Systray

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

Código:
#DEFINE ccicon  "house.ico"  && replace with valid ICO file name

PUBLIC objform
objform = CREATEOBJECT("Tform")
objform.VISIBLE = .T.

DEFINE CLASS tform AS FORM
   WIDTH=400
   HEIGHT=240
   MAXBUTTON=.F.
   MINBUTTON=.F.
   AUTOCENTER=.T.
   CAPTION = " Using Systray icon and menu"

   ADD OBJECT cmdshowicon AS COMMANDBUTTON WITH;
      CAPTION="Show Icon", WIDTH=100, HEIGHT=27,;
      LEFT=20, TOP=20

   ADD OBJECT cmdhideicon AS COMMANDBUTTON WITH;
      CAPTION="Hide Icon", WIDTH=100, HEIGHT=27,;
      LEFT=20, TOP=56

   ADD OBJECT chpopup AS CHECKBOX WITH;
      CAPTION=" Popup enabled", VALUE=.T.,;
      LEFT=240, TOP=20, AUTOSIZE=.T., BACKSTYLE=1

   PROCEDURE INIT
      THIS.addtrayctrl
   ENDPROC

   PROCEDURE addtrayctrl
      LOCAL lerr
      ON ERROR lerr = .T.
      THIS.ADDOBJECT("FoxTray", "TFoxTray")
      ON ERROR
      IF lerr
         = MESSAGEB("ActiveX control not registered  " + CHR(13) +;
            "or VB support not available.            " + CHR(13) + CHR(13) +;
            "Class: FoxTrayCtl.cFoxTray              " + CHR(13) +;
            "File: FoxTray.ocx  " + CHR(13) +;
            "VB support: msvbvm60.dll  ", 48, " FoxTray Control")
      ENDIF
   ENDPROC

   PROCEDURE cmdshowicon.CLICK
      WITH THISFORM.foxtray
         .iconsource = ccicon
         .showicon
      ENDWITH
   ENDPROC

   PROCEDURE cmdhideicon.CLICK
      THISFORM.foxtray.hideicon
   ENDPROC
ENDDEFINE

DEFINE CLASS tfoxtray AS OLECONTROL
   OLECLASS="FoxTrayCtl.cFoxTray"

   PROCEDURE INIT
      WITH THIS
         .iconsource = ccicon
         .icontip = "FoxPro App"
         .showicon

         * setting popup items, max number = 5
         .getpopupitem(1).CAPTION = "Settings"
         .getpopupitem(2).CAPTION = "About"
         .getpopupitem(3).CAPTION = "-"  && separator
         .getpopupitem(4).CAPTION = "Close form"
         .getpopupitem(5).CAPTION = "\Exit"  && item disabled
      ENDWITH
   ENDPROC

   PROCEDURE beforepopupactivate
      PARAMETERS lresult
      lresult = THISFORM.chpopup.VALUE && .F. cancels popup activation
   ENDPROC

   PROCEDURE onpopupitemselected
      LPARAMETERS lnitem, lccaption
      DO CASE
         CASE lnitem = 2
            = MESSAGEB("System Tray Icon and Menu Control  ", 64, " About")
         CASE lnitem = 4
            THISFORM.RELEASE
         CASE lnitem = 5
            IF MESSAGEB("Exit FoxPro?  ", 32+4, " FoxTray Control") = 6
               QUIT
            ENDIF
         OTHER
            = MESSAGEB("Popup item selected: " + LTRIM(STR(lnitem)) +;
               ", [" + lccaption + "]")
      ENDCASE
   ENDPROC
ENDDEFINE

Obs: Requer a DLL "MSVBVM60.DLL"
Fonte:
news2news.com/vfp/?example=336

_________________
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: Systray

Mensagem por Marcos Guedes em 4/11/2010, 12:13

Fiz uma pequena modificação utilizando a rotina acima para controlar uma rotina através do Systray:

Código:
PRIVATE executando AS boolean
m.executando = .T.

obj = NEWOBJECT('AtivaSystray')

m.lotim = CREATEOBJECT( "MinhaRotina" )

READ EVENTS

m.lotim = NULL
obj = NULL

#DEFINE nim_add 0
#DEFINE nim_modify 1
#DEFINE nim_delete 2
#DEFINE nif_message 1
#DEFINE nif_icon 2
#DEFINE nif_tip 4
#DEFINE notifyicondata_size 88
#DEFINE max_path 260
#DEFINE gwl_wndproc -4
#DEFINE image_icon 1
#DEFINE lr_loadfromfile 0x0010
#DEFINE lr_defaultsize 0x0040

#DEFINE wm_mousemove 0x0200
#DEFINE wm_lbuttondown 0x0201
#DEFINE wm_lbuttonup 0x0202
#DEFINE wm_rbuttondown 0x0204
#DEFINE wm_rbuttonup 0x0205
#DEFINE wm_mbuttondown 0x0207
#DEFINE wm_mbuttonup 0x0208

DEFINE CLASS minharotina AS TIMER
   INTERVAL = 5000

   FUNCTION TIMER
      IF (m.executando) THEN
         MESSAGEBOX('Executando!')
      ENDIF
   ENDFUNC

ENDDEFINE

DEFINE CLASS ativasystray AS CUSTOM

   ADD OBJECT taskbaricon AS taskbarstatus

   PROCEDURE INIT AS void
      THIS.showicon(1)
   ENDPROC

   PROCEDURE showicon(nmode)
      * shows or hides icon in the systray
      WITH THIS.taskbaricon
         IF nmode = 0
            .deleteicon
         ELSE
            .baloon = "Acesse http://www.programacaobrasil.com" &&VERSION()
            .initicon(.getdefaulticon())
         ENDIF
      ENDWITH
   ENDPROC

   PROCEDURE taskbaricon.onudfmessage
      PARAMETERS wparam AS INTEGER, LPARAM AS INTEGER
      DODEFAULT()

      DO CASE
         CASE LPARAM=wm_mousemove
            *THISFORM.sbar.panels(1).TEXT = "Mouse moves: " +;
            TRANS(THIS.lastmousex) + ", " + TRANS(THIS.lastmousey)
         CASE LPARAM=wm_lbuttondown
            THIS.PARENT.cliqueesquerdo(THIS.lastmousey,THIS.lastmousex)
            *THISFORM.sbar.panels(2).TEXT = "Left Button Down"
         CASE LPARAM=wm_lbuttonup
            *THISFORM.sbar.panels(2).TEXT = "Left Button Up"
         CASE LPARAM=wm_rbuttondown
            THIS.PARENT.cliquedireito(THIS.lastmousey,THIS.lastmousex)
            *THISFORM.sbar.panels(2).TEXT = "Right Button Down"
         CASE LPARAM=wm_rbuttonup
            *THISFORM.sbar.panels(2).TEXT = "Right Button Up"
         CASE LPARAM=wm_mbuttondown
            *THISFORM.sbar.panels(2).TEXT = "Middle Button Down"
         CASE LPARAM=wm_mbuttonup
            *THISFORM.sbar.panels(2).TEXT = "Middle Button Up"
      ENDCASE
   ENDPROC

   PROCEDURE cliqueesquerdo AS void
      LPARAMETERS lastmousey, lastmousex
      exibeshortcut(m.lastmousey, m.lastmousex)
   ENDPROC

   PROCEDURE cliquedireito AS void
      exibeshortcut(m.lastmousey, m.lastmousex)
   ENDPROC

ENDDEFINE

DEFINE CLASS taskbarstatus AS CUSTOM
   hwindow=0
   appid=1
   messageid=0x4001
   horigproc=0
   hicon=0
   baloon=""
   lastmousex=0
   lastmousey=0

   PROCEDURE INIT
      THIS.DECLARE
      THIS.hwindow = _SCREEN.HWND
      THIS.horigproc = getwindowlong(THIS.hwindow, gwl_wndproc)
   ENDPROC

   PROCEDURE DESTROY
      THIS.deleteicon
   ENDPROC

   PROCEDURE deleteicon
      IF THIS.hicon <> 0
         THIS.seticon(nim_delete)
         = destroyicon(THIS.hicon)
         THIS.hicon = 0

         IF VERSION(5) >= 900  && VFP9+
            = UNBINDEVENTS(THIS.hwindow, THIS.messageid)
         ENDIF
      ENDIF
   ENDPROC

   PROCEDURE initicon(hicon)
      THIS.deleteicon

      DO CASE
         CASE VARTYPE(m.hicon)="N"
            THIS.hicon = m.hicon
         CASE VARTYPE(m.hicon)="C"
            THIS.hicon = THIS.loadicon(m.hicon)
         OTHERWISE
            RETURN
      ENDCASE
      THIS.seticon(nim_add)
   ENDPROC

   PROCEDURE seticon(caction)
      LOCAL cbuffer

      cbuffer = num2dword(notifyicondata_size) +;
         num2dword(THIS.hwindow) +;
         num2dword(THIS.appid) +;
         num2dword(nif_icon + nif_message + nif_tip) +;
         num2dword(THIS.messageid) +;
         num2dword(THIS.hicon) +;
         PADR(THIS.baloon, 64, CHR(0))

      IF shell_notifyicon(m.caction, @cbuffer) <> 0
         IF VERSION(5) >= 900  && VFP9+
            = BINDEVENT(THIS.hwindow, THIS.messageid,;
               THIS, "HookedWindowProc")
         ENDIF
      ENDIF
   ENDPROC

   PROCEDURE getmousepos(nx, ny)
      * retrieves position of the cursor in screen coordinates
      LOCAL cbuffer
      cbuffer = REPLICATE(CHR(0), 8)
      = getcursorpos(@cbuffer)
      nx = buf2dword(SUBSTR(cbuffer, 1,4))
      ny = buf2dword(SUBSTR(cbuffer, 5,4))
   ENDPROC

   PROCEDURE loadicon(ciconfile)
      * loads icon from a file
      LOCAL hicon
      TRY
         hicon = loadimage(0, m.ciconfile, image_icon,;
            0,0, lr_loadfromfile+lr_defaultsize)
      CATCH
         hicon=0
      ENDTRY
      RETURN m.hicon
   ENDPROC

   PROCEDURE getdefaulticon
      * loads application icon
      LOCAL cbuffer, nbufsize, niconindex, hicon
      cbuffer = REPLICATE(CHR(0), max_path)
      nbufsize = getmodulefilename (0, @cbuffer, max_path)
      cbuffer = LEFT(cbuffer, nbufsize)
      niconindex = 0  && works as a reference only
      hicon = extractassociatedicon(0, cbuffer, @niconindex)
      RETURN m.hicon
   ENDPROC

   PROCEDURE onudfmessage(wparam AS INTEGER, LPARAM AS INTEGER)
      * you will probably want to subclass this
      LOCAL nx, ny
      STORE 0 TO nx, ny
      THIS.getmousepos(@nx, @ny)
      THIS.lastmousex=m.nx
      THIS.lastmousey=m.ny
   ENDPROC

   PROCEDURE hookedwindowproc(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=THIS.messageid
            THIS.onudfmessage(wparam, LPARAM)

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

   PROTECTED PROCEDURE DECLARE
      DECLARE INTEGER DestroyIcon IN user32 INTEGER hIcon
      DECLARE INTEGER SetForegroundWindow IN user32 INTEGER hWindow
      DECLARE INTEGER GetCursorPos IN user32 STRING @ lpPoint
      DECLARE INTEGER Shell_NotifyIcon IN shell32 INTEGER dwMsg, STRING @lpdata
      DECLARE INTEGER GetWindowLong IN user32 INTEGER hWindow, INTEGER nIndex

      DECLARE INTEGER ExtractAssociatedIcon IN shell32;
         INTEGER hInst, STRING lpIconPath, INTEGER @lpiIcon

      DECLARE INTEGER GetModuleFileName IN kernel32;
         INTEGER hModule, STRING @lpFilename, INTEGER nSize

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

      DECLARE INTEGER LoadImage IN user32;
         INTEGER hinst, STRING lpszName, INTEGER uType,;
         INTEGER cxDesired, INTEGER cyDesired, INTEGER fuLoad
   ENDPROC

ENDDEFINE

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)
ENDFUNC

FUNCTION num2dword(nvalue)
   #DEFINE m0  0x0100
   #DEFINE m1  0x010000
   #DEFINE m2  0x01000000
   IF nvalue < 0
      nvalue = 0x100000000 + nvalue
   ENDIF
   LOCAL b0, b1, b2, b3
   b3 = INT(nvalue/m2)
   b2 = INT((nvalue - b3*m2)/m1)
   b1 = INT((nvalue - b3*m2 - b2*m1)/m0)
   b0 = MOD(nvalue, m0)
   RETURN CHR(b0)+CHR(b1)+CHR(b2)+CHR(b3)
ENDFUNC

FUNCTION exibeshortcut
   LPARAMETERS lastmousey, lastmousex
   *DEFINE POPUP shortcut FROM MROW(), MCOL() RELATIVE shortcut
   DEFINE POPUP shortcut FROM m.lastmousey, MCOL() RELATIVE shortcut
   *!*
   DEFINE BAR 1 OF shortcut PROMPT "Pausar/Continuar"
   DEFINE BAR 2 OF shortcut PROMPT "\-"
   DEFINE BAR 3 OF shortcut PROMPT "Sair"
   *!*
   ON SELECTION BAR 1 OF shortcut DO pausarsystray
   ON SELECTION BAR 3 OF shortcut DO sairsystray
   *!*
   ACTIVATE POPUP shortcut
ENDFUNC
*!*
PROCEDURE sairsystray AS void
   CLEAR EVENTS
ENDPROC
*!*
PROCEDURE pausarsystray AS void
   m.executando=!m.executando
ENDPROC

Espero que ajude os colegas.

_________________
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: Systray

Mensagem por Conteúdo patrocinado Hoje à(s) 17:22


Conteúdo patrocinado


Voltar ao Topo Ir em baixo

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