IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
logo
Sommaire > Divers > Fonctions système - Interactions Windows > Boites de dialogue Windows
        Afficher la fenêtre Arreter l'ordinateur
        Afficher la fenêtre Exécuter
        Afficher la boîte de dialogue de selection de police
        Afficher la boite de dialogue A propos
        Afficher une boite de dialogue ActiveDirectory
        Afficher une boite de dialogue de sélection de couleur
        Afficher une fenêtre de télechargement pour copier un fichier
        Afficher une msgbox avec l'API Windows
        Inviter l'utilisateur à redémarrer son ordinateur

rechercher
precedent    sommaire    suivant    telecharger


Auteur : Tofalu
Version : 05/02/2005
Page de l'auteur
Afficher la fenêtre Arreter l'ordinateur
Ce code permet d'afficher la fenêtre "Arrêter l'ordinateur" de Windows
Private Declare Function SHShutDownDialog Lib _
"shell32" Alias "#60" (ByVal YourGuess As Long) As Long
Private Sub Arreter()
    SHShutDownDialog 0
End Sub

Auteur : Tofalu
Version : 05/02/2005
Page de l'auteur
Afficher la fenêtre Exécuter
Versions : 97 et supérieures

Ce code permet d'afficher la fenêtre Exécuter du menu démarrer. Cela peut être utile pour permettre à l'utilisateur de selectionner un programme à lancer. Le lancement se fait automatiquement par la fenêtre Exécuter. Ceci évite d'avoir à coder l'ouverture du fichier. Dans un module, placez le code suivant :
Const shrdNoMRUString = &H2
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias _
"GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Private Declare Function SHRunDialog Lib "shell32" Alias "#61" _
(ByVal hOwner As Long, ByVal Unknown1 As Long, ByVal Unknown2 As _
Long, ByVal szTitle As String, ByVal szPrompt As String, _
ByVal uFlags As Long) As Long

Function WindowsNT() As Boolean
    Dim Info As OSVERSIONINFO
    Dim Result As Integer
    Info.dwOSVersionInfoSize = Len(Info)
    'Récupere la version de Windows
    Result = GetVersionEx(Info)
    WindowsNT = (Info.dwPlatformId = 2)
End Function
Public Sub AfficherExecuter()
    Dim Titre As String, Message As String
    Titre = "Lancer un programme"
    Message = "Tapez le nom d'un programme ou bien " & _
       "utilisez le bouton parcourir"
    'Si windows NT, alors utiliser unicode
    If WindowsNT Then
        SHRunDialog 0, 0, 0, StrConv(Titre, vbUnicode), _
            StrConv(Message, vbUnicode), 0
        'sinon, utiliser un string normal
    Else
        SHRunDialog 0, 0, 0, Titre, Message, 0
    End If
End Sub
Le passage de paramètre n'étant pas le même pour les différentes versions de Windows, la fonction WindowsNT permet de savoir sur quelle plateforme est utilisée l'application.


Auteur : Tofalu
Version : 05/03/2005
Page de l'auteur
Téléchargez le zip
Afficher la boîte de dialogue de selection de police
Versions : 2000 et supérieures

Voici un moyen de permettre à l'utilisateur de sélectionner une police. Cet exemple utilise l'API Windows ChooseFont qui affiche la boîte de dialogue commune Windows intitulée Sélectionner une police.

Dans un module :
Public Type Police
  Nom As String
  Taille As Long
  Souligne As Boolean
  Italique As Boolean
  Gras As Boolean
  Barre As Boolean
  Couleur As Long
End Type

Const LOGPIXELSY = 90
Const FW_NORMAL = 400
Const FW_GRAS = 700
Const DEFAULT_CHARSET = 1
Const OUT_DEFAULT_PRECIS = 0
Const CLIP_DEFAULT_PRECIS = 0
Const DEFAULT_QUALITY = 0
Const DEFAULT_PITCH = 0
Const FF_ROMAN = 16
Const CF_PRINTERFONTS = &H2
Const CF_SCREENFONTS = &H1
Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
Const CF_EFFECTS = &H100&
Const CF_FORCEFONTEXIST = &H10000
Const CF_INITTOLOGFONTSTRUCT = &H40&
Const CF_LIMITSIZE = &H2000&
Const CF_NOSCRIPTSEL = &H800000
Const REGULAR_FONTTYPE = &H400
Const LF_FACESIZE = 32
Const GMEM_MOVEABLE = &H2
Const GMEM_ZEROINIT = &H40



Private Type CHOOSEFONT
        lStructSize As Long
        hwndOwner As Long   
        hDC As Long                
        lpLogFont As Long        
        iPointSize As Long       
        flags As Long             
        rgbColors As Long        
        lCustData As Long          
        lpfnHook As Long         
        lpTemplateName As String 
        hInstance As Long        
        lpszStyle As String       
        nFontType As Integer     
        MISSING_ALIGNMENT As Integer
        nSizeMin As Long           
        nSizeMax As Long        
End Type
Private Type LOGFONT
  lfHeight As Long
  lfWidth As Long
  lfEscapement As Long
  lfOrientation As Long
  lfWeight As Long
  lfItalic As Byte
  lfUnderline As Byte
  lfStrikeOut As Byte
  lfCharSet As Byte
  lfOutPrecision As Byte
  lfClipPrecision As Byte
  lfQuality As Byte
  lfPitchAndFamily As Byte
  lfFaceName As String * 31
End Type



Private Declare Function CHOOSEFONT Lib "comdlg32.dll" _
 Alias "ChooseFontA" (pChoosefont As CHOOSEFONT) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias _
 "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function GlobalLock Lib "kernel32" _
 (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" _
 (ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" _
 (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" _
 (ByVal hMem As Long) As Long


Public Function ChoisirPolice(Handle As Long, _
      PoliceParDefaut As Police) As Police

    Dim Boite As CHOOSEFONT, LaPolice As LOGFONT, _
      hMem As Long, pMem As Long
    Dim resultat As Long, Retour As Police
    '*****************************************
    'definit la police par defaut à afficher
    LaPolice.lfStrikeOut = PoliceParDefaut.Barre
    LaPolice.lfWeight = IIf(PoliceParDefaut.Gras, _
        FW_GRAS, FW_NORMAL)
    LaPolice.lfItalic = PoliceParDefaut.Italique
    LaPolice.lfUnderline = PoliceParDefaut.Souligne
    LaPolice.lfHeight = -PoliceParDefaut.Taille * _
     GetDeviceCaps(GetDC(Handle), LOGPIXELSY) / 72
    If PoliceParDefaut.Nom = "" Then _
         PoliceParDefaut.Nom = "Tahoma"
    LaPolice.lfFaceName = PoliceParDefaut.Nom & _
         vbNullChar  'Nom de la police par defaut
    '******************************************
    ' Creer une structure LOGFont en memoire.
    hMem = GlobalAlloc(GMEM_MOVEABLE _
         Or GMEM_ZEROINIT, Len(LaPolice))
    'Verouille et recupere le pointeur vers la structure
    pMem = GlobalLock(hMem)
    'Copie la structure
    CopyMemory ByVal pMem, LaPolice, Len(LaPolice)
    'Initialise la boite de dialogue
    Boite.lStructSize = Len(Boite)
    Boite.hwndOwner = Handle
    'Affecte la police par defaut
    Boite.lpLogFont = pMem
    'defini la taille (10*La taille de la police)
    Boite.iPointSize = 120 'PoliceParDefaut.Taille * 10
    'Personalise la boite
    Boite.flags = CF_BOTH Or CF_EFFECTS Or CF_FORCEFONTEXIST Or _
       CF_INITTOLOGFONTSTRUCT Or CF_LIMITSIZE Or _
       CF_NOSCRIPTSEL
    'Fixe la couleur
    Boite.rgbColors = PoliceParDefaut.Couleur
    Boite.nFontType = REGULAR_FONTTYPE
    'Definit les tailles possibles
    Boite.nSizeMin = 6
    Boite.nSizeMax = 72
    'Ouvre la boite
    resultat = CHOOSEFONT(Boite)
    If resultat <> 0 Then
        CopyMemory LaPolice, ByVal pMem, Len(LaPolice)
        'Prepare le resultat
        Retour.Nom = Left(LaPolice.lfFaceName, _
            InStr(LaPolice.lfFaceName, vbNullChar) - 1)
        Retour.Taille = Boite.iPointSize \ 10
        Retour.Couleur = Boite.rgbColors
        'La police est en gras lorsque largeur n'est pas normale
        Retour.Gras = LaPolice.lfWeight > FW_NORMAL
        Retour.Italique = LaPolice.lfItalic
        Retour.Souligne = LaPolice.lfUnderline
        Retour.Barre = LaPolice.lfStrikeOut
     End If
   'Libère la mémoire
    resultat = GlobalUnlock(hMem) 
    resultat = GlobalFree(hMem)
    ChoisirPolice = Retour
End Function
Puis pour changer la police d'un contrôle, appliquer le code suivant sur un bouton :
Dim P As Police
'Recupere la police actuelle
'pour alimenter les valeurs par
'défaut de la boîte de dialogue
With P
.Barre = False
.Couleur = Lbl_Texte.ForeColor
.Gras = Lbl_Texte.FontBold
.Italique = Lbl_Texte.FontItalic
.Souligne = Lbl_Texte.FontUnderline
.Taille = Lbl_Texte.FontSize
.Nom = Lbl_Texte.fontname
End With
'Affiche la boite de dialogue
P = ChoisirPolice(Me.Hwnd, P)
'Applique la nouvelle valeur au controle
With Lbl_Texte
'si taille=0 alors signife annuler
If P.Taille <> 0 Then
.ForeColor = P.Couleur
.FontBold = P.Gras
.FontItalic = P.Italique
.fontname = P.Nom
.FontUnderline = P.Souligne
.FontSize = P.Taille
End If
End With
Le principe est simple, il suffit de créer un type Police contenant les informations actuelles du contrôle puis d'appeler la boîte de dialogue avec cette police par défaut. Enfin, il faut appliquer le résultat reçu de la boîte de dialogue au contrôle en question.

Pour plus d'informations, n'hésitez pas à télecharger le fichier source zippé.


Auteur : Tofalu
Version : 05/03/2005
Page de l'auteur
Afficher la boite de dialogue A propos
Ce petit exemple est destiné à vous permettre d'afficher la boite de dialogue A propos dans votre application. Cela peut représenter un petit plus dans la personnalisation de votre application et vous permettra par exemple d'afficher la version, etc...

Voici le code :
'Declaration de l'API
Private Declare Function ShellAbout Lib "shell32.dll" Alias _
"ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, _
ByVal szOtherStuff As String, ByVal hIcon As Long) As Long

'Procedure sur le clique d'un bouton
Private Sub AfficherApropos_Click()
Dim Titre As String, Message As String
Titre = "Sources Access"
Message = "Ceci est un exemple de developpez.com sur l'utilisation des API"
ShellAbout me.hwnd, Titre, Message, VICon
End Sub

Auteur : Tofalu
Version : 05/03/2005
Page de l'auteur
Afficher une boite de dialogue ActiveDirectory
Versions : 2000 et supérieures

Ce code permet de sélectionner une ressource ActiveDirectory. Placer dans un module :
Private Const MAX_PATH = 160
Private Type DSBROWSEINFO
    cbStruct As Long
    hwndOwner As Long
    pszCaption As String
    pszTitle As String
    pszRoot As String
    pszPath As Long
    cchPath As Long
    dwFlags As Long
    pfnCallback As Long
    lParam As Long
    dwReturnFormat As Long
    pUserName As String
    pPassword As String
    pszObjectClass As String
    cchObjectClass As Long
End Type
Private Declare Function DsBrowseForContainer Lib "dsuiext" Alias _ 
    "DsBrowseForContainerA" (pInfo As DSBROWSEINFO) As Long
Public Function ActiveDirectory() as string
    Dim dsbi As DSBROWSEINFO, szResult As String
    szResult = Space(MAX_PATH)
    dsbi.cbStruct = Len(dsbi)
    dsbi.pszCaption = "Active Directory"
    dsbi.pszTitle = "Choisir une ressource"
    dsbi.pszPath = StrPtr(szResult)
    dsbi.cchPath = Len(szResult)
    'Appel de la fonction
    DsBrowseForContainer dsbi
    'Renvoit le résultat
    ActiveDirectory=szResult
End Function
Utilisation :
Msgbox ActiveDirectory()
Ceci affiche le nom de la ressource sélectionnée.


Auteur : Tofalu
Version : 04/02/2005
Page de l'auteur
Afficher une boite de dialogue de sélection de couleur
Versions : 97 et supérieures

Ce code utilise les API Windows, afin d'afficher une palette de couleur Windows.
Dans un module, placer le code suivant :
Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias _
"ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
Private Type CHOOSECOLOR
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As String
    flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
Public Function ShowColor(Handle As Long) As Long
    Dim cc As CHOOSECOLOR
    Dim Custcolor(16) As Long
    Dim lReturn As Long

    'set the structure size
    cc.lStructSize = Len(cc)
    'Set the owner
    cc.hwndOwner = Handle
    'set the custom colors (converted to Unicode)
    cc.lpCustColors = StrConv(CustomColors, vbUnicode)
    'no extra flags
    cc.flags = 0

    'Show the 'Select Color'-dialog
    If CHOOSECOLOR(cc) <> 0 Then
        ShowColor = cc.rgbResult
        CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
    Else
        ShowColor = -1
    End If
End Function
Puis, sur l'évênement Clic d'un bouton, placer le code suivant :
Dim lacouleur as long
lacouleur=ShowColor(Me.hwnd)
Si l'utilisateur choisit une couleur, alors la variable lacouleur a pour valeur le code de cette couleur. Sinon, elle vaut -1 (cas où l'utilisateur clique sur Annuler).


Auteur : Tofalu
Version : 04/02/2005
Page de l'auteur
Afficher une fenêtre de télechargement pour copier un fichier
Versions : 97 et supérieures

Ce code permet d'afficher une boite de télechargement pour proposer à l'utilisateur d'enregistrer un fichier et de suivre l'état de la copie à l'aide d'une barre de progression. L'API utiliser peut recevoir soit le nom d'un fichier en local ou une url voire même un chemin réseau.
'Déclaration de l'API
Private Declare Function DoFileDownload Lib "shdocvw.dll" _
(ByVal lpszFile As String) As Long


Public Sub TelechargerFichier(Fichier as string)
   DoFileDownload StrConv(Fichier, vbUnicode)
End Sub
Utilisation :
TelechargerFichier("d:\test.mdb")
TelechargerFichier(""http://www.monsite.fr/monfichier.zip")

Auteur : Tofalu
Version : 04/02/2005
Page de l'auteur
Afficher une msgbox avec l'API Windows
Versions : 97 et supérieures

L'utilisation de l'API Windows pour afficher une boite de dialogue est plus rapide et plus économe en ressource que celle de la fonction VB Msgbox. Dans un module :
Const MB_DEFBUTTON1 = &H0&
Const MB_DEFBUTTON2 = &H100&
Const MB_DEFBUTTON3 = &H200&
Const MB_ICONASTERISK = &H40&
Const MB_ICONEXCLAMATION = &H30&
Const MB_ICONHAND = &H10&
Const MB_ICONINFORMATION = MB_ICONASTERISK
Const MB_ICONQUESTION = &H20&
Const MB_ICONSTOP = MB_ICONHAND
Const MB_OK = &H0&
Const MB_OKCANCEL = &H1&
Const MB_YESNO = &H4&
Const MB_YESNOCANCEL = &H3&
Const MB_ABORTRETRYIGNORE = &H2&
Const MB_RETRYCANCEL = &H5&
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" _
(ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, _
ByVal wType As Long) As Long
Utilisation :
Dim reponse as long
reponse=MessageBox(me.Hwnd, "Voulez vous continuer", _
"Demande de confirmation", MB_YESNO + MB_ICONQUESTION))
If reponse=VbYes then 
'..........
'code à effectuer si l'utilisateur clique sur Oui
End if

Auteur : Tofalu
Version : 05/02/2005
Page de l'auteur
Inviter l'utilisateur à redémarrer son ordinateur
Ce code permet d'afficher un message demandant à l'utilisateur de redémarrer son ordinateur. S'il clique sur oui, le redémarrage se fera automatiquement.
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Const EWX_POWEROFF = 8

Private Declare Function SHRestartSystemMB Lib "shell32" _
Alias "#59" (ByVal hOwner As Long, ByVal sExtraPrompt As String, _
ByVal uFlags As Long) As Long

Private Sub AfficherRedemarrer()
    SHRestartSystemMB 0, vbNullString, EWX_REBOOT
End Sub

rechercher
precedent    sommaire    suivant    telecharger

Valid XHTML 1.1!Valid CSS!

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2005 Maxence Hubiche Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.