ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Afficher un popup avec une toolbar   


L'auteur

eddymaue
Canada Canada
Membre Simple
# 0000000075
enregistré le 26/10/2004
Maue Eddy
j8j 8j8 Gatineau
de la société Formatek
Fiche personnelle

Note des membres
19/20
1 vote

Contributions > 01 - PRG : Programmation

Afficher un popup avec une toolbar
# 0000000461
ajouté le 27/07/2007 22:13:26 et modifié le 28/07/2007
consulté 9031 fois
Niveau débutant

Version(s) Foxpro :
VFP 9.0
VFP 8.0
VFP 7.0
Description

Comment afficher un popup avec une toolbar.

Au début ça parut simple mais je fus vite confronté au fait que si la toolbar est docké, le popup ne suis pas facilement.

Donc pour contourner le problème, il suffit simplement d'activer le popup dans un formulaire avec desktop = 1. Le formulaire n’a même pas besoin d'être visible. C'est simplement une façon de sortir le popup de l’environnement.

Donc on peut docker à gauche, en haut et à droite, ca fonctionne nickel.

Pour ce qui est de docker en bas, malheureuse, ca ne fonctionne pas bien.

Mais au moins ¾ sans problème.

Autre point intéressant, regarder comment je récupère la hauteur et la largeur des textes à afficher.

Avec Vfp 9  et les autres versions je ne sais pas

J'affecte le fontname et fontsize à un objet formulaire et up je récupère mes valeurs dans TextWidth, TextHeight.
C'est nickel et sans erreurs.

 

Code source :
Public otlb As Toolbar
m.otlb = Createobject("tbFenetres")
m.otlb.Show

Define Class tbFenetres As Toolbar
    Add Object btnFavori As Checkbox
    Add Object Separateur As Separator
    Caption = "Fenêtres actives"
    Width = 0
    ControlBox = .T.
    oFormActif = .Null.
    Declare aTextBar(5)
    aTextBar(1) = "UnDocked POSITION"
    aTextBar(2) = "Docked TOP POSITION"
    aTextBar(3) = "Docked LEFT POSITION"
    aTextBar(4) = "Docked RIGHT POSITION"
    aTextBar(5) = "Docked BOTTOM POSITION"

    dtop = 0

    Procedure Init

        This.btnFavori.Style = 1
        This.btnFavori.Caption = "Docked ?"

    Endproc

    Procedure btnFavori.RightClick()

        Local oSTF As Form
        With This.Parent
            oSTF = Createobject("ShowToolFrm",This.Parent)
            oSTF.Show()
        Endwith
    Endproc

Enddefine



Define Class ShowToolFrm As Form
    Desktop = 1
    WindowType= 1
    TitleBar= 0
    BorderStyle=0
    Width = 10
    Height = 10
    cx = 0
    cy = 0
    oSource=.F.

    FontName= "Georgia"
    FontSize= 20

    lnPopupHeight = 0
    lnPopupWidth = 0




    *  /¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ LOAD
    * / Eddy Maue a+  --   Créer le : 2007-07-27
    Procedure Load
        nDll = Adlls(laDll)
        If nDll = 0 Or Ascan(laDll,    Lower("ApiGetCursorPos"),1,-1,-1,9) = 0
            Declare Integer GetCursorPos In user32 As ApiGetCursorPos String @lpPoint
        Endif

    Endproc && LOAD



    *  /¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ GetCursorPos
    * / Eddy Maue a+  --   Créer le : 2007-07-27
    Procedure GetCursorPos()

        Local cBuffer
        cBuffer = Replicate(Chr(0), 8)
        = ApiGetCursorPos(@cBuffer)
        With This
            .cx = .Buf2DWord(Substr(cBuffer, 1,4))
            .cy = .Buf2DWord(Substr(cBuffer, 5,4))
        Endwith



    Endproc && GetCursorPos




    *  /¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ Init
    * / Eddy Maue a+  --   Créer le : 2007-07-27
    Procedure Init
        Lparameters oSource As Toolbar
        Assert Vartype(oSource)=="O" And !Isnull(oSource) ;
            Message "la source n'est pas àdéquate "

        This.oSource = oSource

        With This
            Local lnPopupHeight, lnPopupWidth , llScreenHeight ,llScreenWidth
            .GetCursorPos()
            lnPopupHeight = 0
            lnPopupWidth = 0
            .MaxTextWidhtHeight(@lnPopupWidth,@lnPopupHeight)
            .lnPopupHeight = lnPopupHeight
            .lnPopupWidth = lnPopupWidth

            llScreenHeight = .cy + m.lnPopupHeight  > Sysmetric(2)
            llScreenWidth  = .cx + m.lnPopupWidth   > Sysmetric(1)

            Thisform.Left= .cx - Iif(m.llScreenWidth ;
                , m.lnPopupWidth ;
                ,0 )
            Thisform.Top = .cy && - Iif( m.llScreenHeight ;
                , m.lnPopupHeight  ;
                , 0 )


        Endwith


    Endproc && Init



    *  /¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ MaxTextWidht
    * / Eddy Maue a+  --   Créer le : 2007-07-27
    Procedure MaxTextWidhtHeight
        Lparameters lnWidth,lnHeight

        Local o As Toolbar , i As Integer
        With Thisform
            o = .oSource
            m.lnWidth = 0
            m.lnHeight = 0
            For i = 1 To Alen(o.aTextBar)
                m.lnWidth = Max(.TextWidth(o.aTextBar(i)),m.lnWidth )
                m.lnHeight = Max(.TextHeight(o.aTextBar(i)),m.lnHeight )
            Endfor
            m.lnHeight = (Alen(o.aTextBar) * m.lnHeight )+10
            m.lnWidth = m.lnWidth + 40
        Endwith

    Endproc && MaxTextWidht


    *  /¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ Activate
    * / Eddy Maue a+  --   Créer le : 2007-07-27
    Procedure Activate

        Private o
        o = This.oSource
        Deactivate Popup raccourci
        Define Popup raccourci SHORTCUT Relative  Font Thisform.FontName ,Thisform.FontSize

        For i = 1 To Alen(o.aTextBar)
            dobar = [Define Bar ]+Transform(i)+[ Of raccourci Prompt "]+o.aTextBar(i)+["]
            &dobar
        Endfor

        On Selection Bar 1 Of raccourci o.Dock(-1)
        On Selection Bar 2 Of raccourci o.Dock(0)
        On Selection Bar 3 Of raccourci o.Dock(1)
        On Selection Bar 4 Of raccourci o.Dock(2)
        On Selection Bar 5 Of raccourci o.Dock(3)

        Activate Popup raccourci
        Release Popup raccourci
        Release Thisform

    Endproc && Activate



    *  /¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ Buf2DWord
    * / Eddy Maue a+  --   Créer le : 2007-07-27
    Procedure Buf2DWord
        Lparameters lcBuffer
        #Define MAX_DWORD 0xffffffff
        #Define MAX_LONG 0x7FFFFFFF
        Local lnResult
        lnResult = Asc(Substr(lcBuffer, 1,1)) + ;
            Asc(Substr(lcBuffer, 2,1)) * 256 +;
            Asc(Substr(lcBuffer, 3,1)) * 65536 +;
            Asc(Substr(lcBuffer, 4,1)) * 16777216
        Return Iif(lnResult>MAX_LONG, lnResult-MAX_DWORD, lnResult)
    Endproc && Buf2DWord




Enddefine
Commentaires
le 02/08/2007, Miky a écrit :
Merci Eddy, je regarde ça de ce pas ! :)
le 02/08/2007, Miky a écrit :
hum, apres tests ça m'a l'air de fonctionner dans tout les sens ! Merci beaucoup Me Eddy :)
le 02/08/2007, Miky a écrit :
J'ai quelques peu simplifié :

DEFINE CLASS calage_popup AS Form
Desktop = 1
WindowType = 1
TitleBar = 0
BorderStyle = 0
Width = 10
Height = 10
FontName = "Arial"
FontSize = 9

PROCEDURE Load
IF ADLLS(aDeclare) = 0 OR ASCAN(aDeclare, LOWER("ApiGetCursorPos"), 1, -1, -1, 9) = 0
DECLARE INTEGER GetCursorPos IN user32 AS ApiGetCursorPos STRING @lpPoint
ENDIF
ENDPROC

PROCEDURE Init
LOCAL cBuffer
cBuffer = REPLICATE(CHR(0), 8)
=ApiGetCursorPos(@cBuffer)
This.Left = This.Buf2DWord(SUBSTR(cBuffer, 1, 4))
This.Top = This.Buf2DWord(SUBSTR(cBuffer, 5, 4))
ENDPROC

PROCEDURE Activate
ACTIVATE POPUP raccourci
RELEASE POPUPS raccourci
Thisform.Release()
ENDPROC

PROCEDURE Buf2DWord
LPARAMETERS lpcBuffer
#DEFINE MAX_DWORD 0xFFFFFFFF
#DEFINE MAX_LONG 0x7FFFFFFF
LOCAL nResult
nResult = ASC(SUBSTR(lpcBuffer, 1,1)) + ;
ASC(SUBSTR(lpcBuffer, 2,1)) * 256 + ;
ASC(SUBSTR(lpcBuffer, 3,1)) * 65536 + ;
ASC(SUBSTR(lpcBuffer, 4,1)) * 16777216
RETURN IIF(nResult > MAX_LONG, nResult - MAX_DWORD, nResult)
ENDPROC
ENDDEFINE

Il suffit de définir un popup comme ceci pour que cela fonctionne :

DEACTIVATE POPUP raccourci
DEFINE POPUP raccourci SHORTCUT RELATIVE
DEFINE BAR 1 OF raccourci PROMPT "Option de menu contextuel"
ON SELECTION BAR 1 OF raccourci DO monprogramme
oCalpop = CREATEOBJECT("calage_popup")
oCalpop.Show()

Encore bravo et merci pour ce code qui m'a bien aidé !!!

A+
le 02/08/2007, eddymaue a écrit :
Salut Miki, ton code fonctionne très bien si on a un seul écran sur l'ordi. Mais chez moi j'en ai 2, ce qui fait que j'ai un débordement sur la droite. Il faut au minimum tenir compte de la position lorsqu'on affiche la droite de l'écran.
www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2025.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3