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

Un alternative à Closable = .F. (Blague) et un formulaire sans fond   



L'auteur

Mike Gagnon
Canada Canada
Membre Simple
# 0000000025
enregistré le 14/10/2004

Gagnon Mike
Pte Claire Quebec - Canada
de la société MCRG Software
Fiche personnelle


Note des membres
pas de note

Contributions > 20 - Trucs et Astuces

Un alternative à Closable = .F. (Blague) et un formulaire sans fond
# 0000000424
ajouté le 11/03/2007 12:58:11 et modifié le 11/03/2007
consulté 5633 fois
Niveau débutant

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

Description

Voici comment empêcher l'utilisateur de fermer la forme avec le 'X'. On le fait disparaitre tout simplement. Ce code viens de news2news.com

Le deuxième example montre qu'en changant quelques paramètres on peut obtenir des résultats différents.




Code source :
&& Faire disparaitre le 'X' d'une forme

PUBLIC frm
frm = CreateObject ("Tform")
frm.Visible = .T.

DEFINE CLASS Tform As Form
    Width = 500
    Height = 300
    AutoCenter = .T.
    Caption = "Le bouton pour fermer la forme est...disparu"

PROCEDURE  Load
    DECLARE INTEGER GetSystemMetrics IN user32 INTEGER nIndex
    DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject
    DECLARE INTEGER GetFocus IN user32

    DECLARE SetWindowRgn IN user32;
        INTEGER hWndINTEGER hRgn, SHORT bRedraw

    DECLARE SHORT GetWindowRect IN user32;
        INTEGER  hwndSTRING @ lpRect

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

    DECLARE INTEGER CombineRgn IN gdi32;
        INTEGER hrgnDest, INTEGER hrgnSrc1, INTEGER hrgnSrc2,;
        INTEGER fnCombineMode

PROCEDURE Activate
    THIS.RegionOn

PROCEDURE  Resize
    THIS.RegionOn

PROCEDURE  RegionOn
#DEFINE SM_CXSIZE  30
#DEFINE SM_CYSIZE  31
#DEFINE SM_CXFRAME 32
#DEFINE SM_CYFRAME 33
#DEFINE RGN_XOR     3

    LOCAL lnBtnWidth, lnBtnHeight, hRgnBase, hRgnExcl, hwnd, x1,y1
     lnBtnWidth = GetSystemMetrics(SM_CXSIZE) +;
        GetSystemMetrics(SM_CXFRAME) + 1

    lnBtnHeight = GetSystemMetrics(SM_CYSIZE) +;
        GetSystemMetrics(SM_CYFRAME) + 1

    hwnd = GetFocus()
    THIS.GetFormRect (hwnd, @x1,@y1)

    hRgnBase = CreateRectRgn (0,0,x1,y1)
    hRgnExcl = CreateRectRgn (x1-lnBtnWidth,0,x1,lnBtnHeight)
    = CombineRgn (hRgnBase, hRgnBase, hRgnExcl, RGN_XOR)

    = SetWindowRgn (hwnd, hRgnBase, 1)
    = DeleteObject (hRgnBase)
    = DeleteObject (hRgnExcl)

PROCEDURE  GetFormRect (hwnd, x1,y1)
    LOCAL lpRect
    lpRect = SPACE(16)
    = GetWindowRect (hwnd, @lpRect)

    x1 = THIS.buf2dword (SUBSTR(lpRect, 9,4)) -;
        THIS.buf2dword (SUBSTR(lpRect, 1,4))

    y1 = THIS.buf2dword (SUBSTR(lpRect, 13,4)) -;
        THIS.buf2dword (SUBSTR(lpRect, 5,4))

FUNCTION  buf2dword (lcBuffer)
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
    Asc(SUBSTR(lcBuffer, 2,1)) * 256 +;
    Asc(SUBSTR(lcBuffer, 3,1)) * 65536 +;
    Asc(SUBSTR(lcBuffer, 4,1)) * 16777216

ENDDEFINE

&& Formulaire sans fonds.

PUBLIC frm
frm = CreateObject ("Tform")
frm.Visible = .T.

DEFINE CLASS Tform As Form
    Width = 500
    Height = 300
    AutoCenter = .T.
    Caption = "Un forme sans fond?"

PROCEDURE  Load
    DECLARE INTEGER GetSystemMetrics IN user32 INTEGER nIndex
    DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject
    DECLARE INTEGER GetFocus IN user32

    DECLARE SetWindowRgn IN user32;
        INTEGER hWndINTEGER hRgn, SHORT bRedraw

    DECLARE SHORT GetWindowRect IN user32;
        INTEGER  hwndSTRING @ lpRect

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

    DECLARE INTEGER CombineRgn IN gdi32;
        INTEGER hrgnDest, INTEGER hrgnSrc1, INTEGER hrgnSrc2,;
        INTEGER fnCombineMode

PROCEDURE Activate
    THIS.RegionOn

PROCEDURE  Resize
    THIS.RegionOn

PROCEDURE  RegionOn
#DEFINE SM_CXSIZE  1
#DEFINE SM_CYSIZE  31
#DEFINE SM_CXFRAME 32
#DEFINE SM_CYFRAME 33
#DEFINE RGN_XOR     3

    LOCAL lnBtnWidth, lnBtnHeight, hRgnBase, hRgnExcl, hwnd, x1,y1
     lnBtnWidth = GetSystemMetrics(SM_CXSIZE) +;
        GetSystemMetrics(SM_CXFRAME) + 1
    lnBtnHeight = GetSystemMetrics(SM_CYSIZE) +;
         GetSystemMetrics(SM_CYFRAME) + 1
    hwnd = GetFocus()
    THIS.GetFormRect (hwnd, @x1,@y1)

    hRgnBase = CreateRectRgn (300,350,x1,y1)
    hRgnExcl = CreateRectRgn (x1-lnBtnWidth,0,x1,lnBtnHeight)
    = CombineRgn (hRgnBase, hRgnBase, hRgnExcl, RGN_XOR)

    = SetWindowRgn (hwnd, hRgnBase, 1)
    = DeleteObject (hRgnBase)
    = DeleteObject (hRgnExcl)

PROCEDURE  GetFormRect (hwnd, x1,y1)
    LOCAL lpRect
    lpRect = SPACE(16)
    = GetWindowRect (hwnd, @lpRect)

    x1 = THIS.buf2dword (SUBSTR(lpRect, 9,4)) -;
        THIS.buf2dword (SUBSTR(lpRect, 1,4))

    y1 = THIS.buf2dword (SUBSTR(lpRect, 13,4)) -;
        THIS.buf2dword (SUBSTR(lpRect, 5,4))

FUNCTION  buf2dword (lcBuffer)
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
    Asc(SUBSTR(lcBuffer, 2,1)) * 256 +;
    Asc(SUBSTR(lcBuffer, 3,1)) * 65536 +;
    Asc(SUBSTR(lcBuffer, 4,1)) * 16777216

ENDDEFINE
Commentaires
Aucun commentaire enregistré ...

Publicité

Les pubs en cours :

www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2019.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3