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
Pointe Cla H9R 3K8
de la société Carver Technologies Inc.
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é 8988 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é ...

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