Enlever le X sup. droit MAIS garder l'icône sup. gaucheRésolu

Question

Bonjour,

Je m'explique... (pour les impatients, voir le 3e paragraphe)

J'ai une form dans laquelle j'ai déjà enlevés les boutons pour 'Réduire la form dans la barre de tâche' et celui pour 'Agrandir Et Réduire la grosseur de la form' en modifiant la fonction 'BorderStyle' à '3 - Single Dialog' .

Maintenant, je veux enlever le bouton X (fermer la fenêtre) mais lorsque je veux le faire (Modifier 'ControlBox' à 'False') la petite icône dans le coin supérieur gauche disparaît comme par enchantement!

Je voudrais donc savoir si il y a une méthode qui pourrait me servir à laisser cette icône (sup. gauche - barre titre) en place mais d'enlever tous les boutons de la barre de titres.

Merci d'avance

cs_EBArtSoft · Accepted Answer

C'est possible en sous-classant la fenetre demo :


'Dans frmMain.frm :
VERSION 5.00
Begin VB.Form frmMain 
   Caption         =   "Form1"
   ClientHeight    =   1725
   ClientLeft      =   3765
   ClientTop       =   1770
   ClientWidth     =   3630
   LinkTopic       =   "Form1"
   ScaleHeight     =   115
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   242
   Begin VB.CommandButton Command1 
      Caption         =   "Quitter"
      Height          =   495
      Left            =   960
      TabIndex        =   0
      Top             =   600
      Width           =   1695
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private mCaption As String
Private mhIcon   As Long

Private Sub Form_Load()
    mCaption = Me.Caption
    Me.Caption = ""
    OldWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
    SetWindowLong Me.hwnd, GWL_STYLE, GetWindowLong(Me.hwnd, GWL_STYLE) And Not (WS_SYSMENU)
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    SetWindowLong Me.hwnd, GWL_WNDPROC, OldWindowProc
End Sub

Private Sub Command1_Click()
    Unload Me
End Sub

Public Sub PaintNC(ByVal Active As Boolean)
    Dim vdc As Long
    Dim vbx As Long
    Dim vby As Long
    Dim vbh As Long
    Dim vbw As Long
    Dim vth As Long
    Dim vix As Long
    Dim viy As Long
    vdc = GetWindowDC(hwnd)
    vbw = GetSystemMetrics(SM_CXSIZE)
    vbx = GetSystemMetrics(SM_CXFRAME)
    vby = GetSystemMetrics(SM_CYFRAME)
    vix = GetSystemMetrics(SM_CXSMICON)
    viy = GetSystemMetrics(SM_CYSMICON)
    vbh = GetSystemMetrics(SM_CYCAPTION)
    vth = Int((vbh - TextHeight(mCaption)) / 2) + vby
    DrawIconEx vdc, vbx, vby + Int((vbh - 16) / 2), Me.Icon.Handle, vix, viy, 0, 0, 3
    SetBkMode vdc, 0
    SetTextColor vdc, IIf(Active, GetSysColor(&H9), GetSysColor(&H13))
    TextOut vdc, vbx + vix + 2, vth, mCaption, Len(mCaption)
    ReleaseDC Me.hwnd, vdc
End Sub



'dans modSubc.bas :
Attribute VB_Name = "modSubc"
Option Explicit

Public Const GWL_WNDPROC = (-4)
Public Const GWL_STYLE = (-16)

Public Const SM_CXFRAME = 32
Public Const SM_CYFRAME = 33
Public Const SM_CXSIZE = 30
Public Const SM_CYCAPTION = 4
Public Const SM_CXSMICON   As Long = 49
Public Const SM_CYSMICON   As Long = 50

Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_SYSMENU = &H80000

Public Const WM_NCPAINT = &H85
Public Const WM_ACTIVATE = &H6
Public Const WM_NCACTIVATE = &H86
Public Const WM_MDIACTIVATE = &H222
Public Const WM_SETTEXT = &HC
Public Const WM_SYSCOMMAND = &H112

Public Const SC_CLOSE = &HF060&

Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Public OldWindowProc As Long

Public Function NewWindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    NewWindowProc = True
    Select Case msg
        Case WM_NCPAINT
            DefWindowProc hwnd, msg, wParam, lParam
            frmMain.PaintNC True

        Case WM_NCACTIVATE
            DefWindowProc hwnd, msg, wParam, lParam
            If wParam Then
                frmMain.PaintNC True
            Else
                frmMain.PaintNC False
            End If

        Case WM_SETTEXT
            DefWindowProc hwnd, msg, wParam, lParam
            frmMain.PaintNC True

        Case WM_SYSCOMMAND
            DefWindowProc hwnd, msg, wParam, lParam
            If (wParam <> SC_CLOSE) Then frmMain.PaintNC True

        Case Else
            NewWindowProc = CallWindowProc(OldWindowProc, hwnd, msg, wParam, lParam)
            
    End Select
End Function


@+

E.B.

cs_DARKSIDIOUS · Answer

Tu peux désactiver le bouton de fermeture si tu veux, mais je ne vois pas comment l'enlever sans enlever le menu système...
_______________________________________

DarK Sidious

[Responsable API/VB du site www.ProgOtoP.com]
Téléchargez ProgOtoP API Viewer

cs_Acolyte · Answer

Il parait que l'on peut mais en faite fat tout viré et après refaire sois mêm toute la barre avec les éléments que l'on souhaite.
faut changer les propriété de la form
Border : style none
après j'en sais rien

++

et bonne prog.

_________________________________________
Acolyte vous remercie...

                                                    by Acolyte
_________________________________________

:)

cs_trabice · Answer

lu

c kel langage le bout de code que tu as donné ??

fabrice

cs_EBArtSoft · Answer

trabice>C'est du "visual fox sharp sql pro point net" ou... du vb6  ;) 

@+

E.B.

cs_trabice · Answer

Begin VB.Form frmMain 
 
c du VB6 ?

ah..

thx

cs_EBArtSoft · Answer

Tu places le code dans un fichier texte que tu renome "frmMain.frm" puis tu double clique dessus et ohhhh par magie sa s'ouvre  ;) 

@+

E.B.

cs_trabice · Answer

j essaierai..

thx
j'en apprend ts les jours

fabrice

danielgrd · Answer

Ca Marche! Merci...

Par contre il faut préciser que l'icone apparait moins de qualité. Mais cela me suffit... C'est parfait!

Merci
@+

Enlever le X sup. droit MAIS garder l'icône sup. gauche

9 réponses

Discussions similaires