Bien que la balise indiquée (Basic) indique que ce code est général, il est recommandé de mentionner avec quel module (Writer, Calc, etc) vous l'utilisez. Notamment pour l'interface entre le dialogue et l'application qui l'appelle.
Copier / coller le code ci-dessous dans un module Basic de votre choix et exécuter la macro Main
Code : Tout sélectionner
'************************************************************
' Ce code vous est fourni sous licence CECILL
' Support depuis le forum officiel francophone
' http://forum.openoffice.org/fr
' Version 1.3 du 17/08/2018
'************************************************************
Private oDlgModele As object
Private oDlgControle As object
Private nNbControles As Long
Private nbreOrdi As Long
Private nbreImpr As Long
Private nbreServ As Long
Private bOK As Boolean
Sub Main
nbreOrdi = 0
nbreImpr = 0
nbreServ = 0
bOK = False
' Création du dialogue :
' + Position X et Y
' + Largeur et hauteur
' + Titre
Dlg_Creation( 60, 50, 200, 140, "Compteur du parc" )
' Un libellé
Dlg_Libelle( 5, 10, 100, 14, "lbl1", "Ajoutez un matériel dans le parc :" )
' Boutons OK et Annule
' + Position X et Y
' + Largeur et hauteur
' + Nom logique, titre et nom du listener (optionnel)
Dlg_Bouton( 90, 120, 50, 14, "dlgValide", "OK", "ValideOuAnnule" )
Dlg_Bouton( 145, 120, 50, 14, "dlgAnnule", "Annuler", "ValideOuAnnule" )
' Boutons classiques avec une procédure dédiée
Dlg_Bouton( 5, 30, 50, 14, "actionOrdi", "Ordinateur" )
Dlg_Bouton( 5, 50, 50, 14, "actionImpr", "Imprimante" )
' Une case à cocher
' + Position X et Y
' + Largeur et hauteur
' + Nom logique, titre et nom du listener (optionnel)
Dlg_Coche( 60, 32, 60, 14, "cocheWin", "Système Windows", True )
' Une zone de texte
' + Position X et Y
' + Largeur et hauteur
' + Nom logique, contenu (optionnel)
' + nom du listener (optionnel)
Dlg_Texte( 118, 30, 78, 14, "txtOS", "Vista")
' Une liste déroulante
' + Position X et Y
' + Largeur et hauteur
' + Nom logique, contenu
' + Déroulante (vrai) ou fixe (false)
' + nom du listener (optionnel)
contenu = Array ("Jet d'encre","Laser","Aiguille")
Dlg_Liste( 60, 50, 60, 34, "lstImpr", contenu, 0)
' Un contrôle fichier
' + Position X/Y
' + largeur / hauteur
' + infobulle
Dlg_fichier( 5, 90, 180, 14, "Sélectionnez un fichier à joindre")
' Un hyperlien
' + Position X/Y
' + largeur / hauteur
' + nom affiché
' + URL
Dlg_hyperlien( 10, 122, 60, 80, "Propulsé par Dude", "http://forum.openoffice.org/fr")
' Affichage du dialogue une fois construit
Dlg_Affiche()
' Affichage du résultat si bOK
if bOK then
MsgBox ("Le parc se compose de "& nbreOrdi &" ordinateur(s) "& _
nbreImpr &" imprimante(s) ")
end if
End Sub
'************************************************************
' Description des contrôles
'************************************************************
Sub Dlg_Creation( x As Long, y As Long, larg As Long, haut As Long, cTitre As String )
oDlgModele = createUnoService( "com.sun.star.awt.UnoControlDialogModel" )
oDlgModele.PositionX = x
oDlgModele.PositionY = y
oDlgModele.Width = larg
oDlgModele.Height = haut
oDlgModele.Title = cTitre
oDlgControle = createUnoService( "com.sun.star.awt.UnoControlDialog" )
oDlgControle.setModel( oDlgModele )
nNbControles = 0
End Sub
Sub Dlg_Bouton( x As Long, y As Long, larg As Long, haut As Long, cNom As String, cLib As String,_
Optional cNomListener As String )
oBoutonModele = oDlgModele.createInstance( "com.sun.star.awt.UnoControlButtonModel" )
oBoutonModele.PositionX = x
oBoutonModele.PositionY = y
oBoutonModele.Width = larg
oBoutonModele.Height = haut
oBoutonModele.Name = cNom
oBoutonModele.TabIndex = nNbControles
oBoutonModele.Label = cLib
oDlgModele.insertByName( cNom, oBoutonModele )
oBoutonControle = oDlgControle.getControl( cNom )
' Création du listener
If IsMissing( cNomListener ) Then
cNomListener = cNom
EndIf
oActionListener = CreateUnoListener( cNomListener + "_", "com.sun.star.awt.XActionListener" )
oBoutonControle.addActionListener( oActionListener )
nNbControles = nNbControles + 1
End Sub
Sub Dlg_Texte( x As Long, y As Long, larg As Long, haut As Long, cNom As String, _
Optional cTexte As String, _
Optional cNomListener As String )
oTexteModele = oDlgModele.createInstance( "com.sun.star.awt.UnoControlEditModel" )
oTexteModele.PositionX = x
oTexteModele.PositionY = y
oTexteModele.Width = larg
oTexteModele.Height = haut
oTexteModele.Name = cNom
oTexteModele.TabIndex = nNbControles
oTexteModele.Text = cTexte
oDlgModele.insertByName( cNom, oTexteModele )
oTexteControle = oDlgControle.getControl( cNom )
' Création du listener
If IsMissing( cNomListener ) Then cNomListener = cNom
oActionListener = CreateUnoListener( cNomListener + "_", "com.sun.star.awt.XFocusListener" )
oTexteControle.addFocusListener( oActionListener )
nNbControles = nNbControles + 1
End Sub
Sub Dlg_Liste( x As Long, y As Long, larg As Long, haut As Long, cNom As String, _
contenu As Array, _
Optional bDeroule As Boolean, _
Optional cNomListener As String )
oListeModele = oDlgModele.createInstance( "com.sun.star.awt.UnoControlListBoxModel" )
oListeModele.PositionX = x
oListeModele.PositionY = y
oListeModele.Width = larg
oListeModele.Height = haut
oListeModele.Name = cNom
oListeModele.TabIndex = nNbControles
oListeModele.DropDown = False
If bDeroule Then
oListeModele.DropDown = 1
EndIf
oDlgModele.insertByName( cNom, oListeModele )
oListeControle = oDlgControle.getControl( cNom )
oListeControle.addItems( contenu(), 0)
' Nombre d'éléments affichable dans la liste : maximum 5
If ( UBound(contenu) > 5 ) Then
nbElements = UBound(contenu)+1
Else
nbElements = 5
EndIf
oListeControle.setDropDownLineCount(nbElements)
' Création du listener
If IsMissing( cNomListener ) Then
cNomListener = cNom
EndIf
oActionListener = CreateUnoListener( cNomListener + "_", "com.sun.star.awt.XActionListener" )
oListeControle.addActionListener( oActionListener )
nNbControles = nNbControles + 1
End Sub
Sub Dlg_Coche( x As Long, y As Long, larg As Long, haut As Long, cNom As String, cLib As String,_
Optional bCoche As Boolean,_
Optional cNomListener As String )
oCocheModele = oDlgModele.createInstance( "com.sun.star.awt.UnoControlCheckBoxModel" )
' Initialize the button model's properties.
oCocheModele.PositionX = x
oCocheModele.PositionY = y
oCocheModele.Width = larg
oCocheModele.Height = haut
oCocheModele.Name = cNom
oCocheModele.TabIndex = nNbControles
oCocheModele.Label = cLib
oCocheModele.State = 0
If bCoche Then
oCocheModele.State = 1
EndIf
oDlgModele.insertByName( cNom, oCocheModele )
oCocheControle = oDlgControle.getControl( cNom )
' Les boutons doivent avoir une écoute
' Création d'une procédure pour recevoir l'événement
If IsMissing( cNomListener ) Then
cNomListener = cNom
EndIf
oActionListener = CreateUnoListener( cNomListener + "_", "com.sun.star.awt.XActionListener" )
oCocheControle.addActionListener( oActionListener )
nNbControles = nNbControles + 1
End Sub
Sub Dlg_Libelle( x As Long, y As Long, larg As Long, haut As Long, cNom As String, cLib As String )
oLibModele = oDlgModele.createInstance( "com.sun.star.awt.UnoControlFixedTextModel" )
oLibModele.PositionX = x
oLibModele.PositionY = y
oLibModele.Width = larg
oLibModele.Height = haut
oLibModele.Name = cNom
oLibModele.TabIndex = nNbControles
oLibModele.Label = cLib
oDlgModele.insertByName( cNom, oLibModele )
oLibControle = oDlgControle.getControl( cNom )
nNbControles = nNbControles + 1
End Sub
Sub Dlg_Hyperlien( x As Long, y As Long, larg As Long, haut As Long, cNom As String, cURL As String )
oModele = oDlgModele.createInstance("com.sun.star.awt.UnoControlFixedHyperlinkModel")
oModele.Name = "Hyperlien"
oModele.TabIndex = nNbControles
oModele.PositionX = x
oModele.PositionY = y
oModele.Width = larg
oModele.Height = haut
oModele.Label = cNom
oModele.URL = cURL
oModele.Align = 1 ' 0 : Gauche / 1 : Centre / 2 : Droite
oModele.Border = 0
oModele.TextColor = RGB(0,0,255) ' Bleu
oModele.Enabled = true
nNbControles = nNbControles + 1
oDlgModele.insertByName("Hyperlien", oModele)
End Sub
Sub Dlg_Fichier( x As Long, y As Long, larg As Long, haut As Long, cInfoBulle As String )
oModele = oDlgModele.createInstance("com.sun.star.awt.UnoControlFileControlModel")
oModele.Name = "FichierJoint"
oModele.TabIndex = nNbControles
oModele.PositionX = x
oModele.PositionY = y
oModele.Width = larg
oModele.Height = haut
oModele.HelpText = cInfoBulle
oModele.Border = 1
nNbControles = nNbControles + 1
oDlgModele.insertByName("FichierJoint", oModele)
End Sub
'************************************************************
' Description des procédures
'************************************************************
Sub Dlg_Affiche()
oDlgControle.setVisible( True )
oDlgControle.execute()
End Sub
Sub Dlg_Ferme()
oDlgControle.endExecute()
oDlgControle.setVisible( False )
End Sub
' Voici maintenant les listeners
Sub actionOrdi_actionPerformed()
nbreOrdi = nbreOrdi + 1
End Sub
Sub actionImpr_actionPerformed()
nbreImpr = nbreImpr + 1
End Sub
' Listener unique pour OK ou Annuler
Sub ValideOuAnnule_actionPerformed(oEve)
If oEve.Source.getModel().Name = "dlgValide" Then
bOK = True
EndIf
' On ferme le dialogue de toute façon
Dlg_Ferme()
End Sub
Sub lstImpr_actionPerformed()
' On ne fait rien mais on pourrait
End Sub
Sub cocheWin_actionPerformed( oEve )
MoiMeme = oEve.Source.getModel()
' On récupère l'objet txtOS
Cible = oDlgControle.getControl("txtOS").getModel()
' Si case cochée, on change le contenu
If MoiMeme.State Then
Cible.Text = "Vista"
Else
Cible.Text = ""
EndIf
End Sub
Sub txtOS_focusLost( oEve )
' Perte du focus de la zone de texte
MoiMeme = oEve.Source.getModel()
'Retour couleur de fond en blanc
MoiMeme.Backgroundcolor = RGB(255, 255, 255)
End Sub
Sub txtOS_focusGained( oEve )
' Prise du focus
MoiMeme = oEve.Source.getModel()
' couleur de fond en jaune pâle
MoiMeme.Backgroundcolor = RGB(255, 255, 204)
End Sub
Historique :
- 1.0 : contrôles bouton, case à cocher et liste / évènement clic bouton
- 1.1 : contrôle zone de texte / évènement coche, focus texte
- 1.2 : hyperlien
- 1.3 : contrôle chemin vers fichier