Soyez le premier à donner votre avis sur cette source.
Vue 5 807 fois - Téléchargée 307 fois
'******************************************************************** 'exemple de fonction appelée ChooseColor() qui utilise la boîte de dialogue 'Couleur standard Microsoft Windows afin que vous pouvez choisir parmi un plus grand 'choix de couleurs ou créer votre propre couleur personnalisée. ' ' ' ARGUMENTS: Couleur par défaut type long ' ' RETURN VALUE: ' >=0 The user-selected RGB value ' -1 erreur COMMDLG. Une message box affichera le numéro d'erreur ' Cette source adapte le code de démonstartion du sit aide et support ' de microsoft pour access http://support.microsoft.com/kb/109390/fr ' la source original utilisé des declaratios d'api obsolètes ' ******************************************************************** Option Explicit ' Tableau contenant les definitions des couleurs personalisées Dim CustomColors(15) As Long Function ChooseColorDlg(ByVal DefaultColor As Long) As Long Dim C As ChooseColor Dim Result As Integer, i As Integer ' Initialise la structure Choose Color C.lStructSize = Len(C) C.hwndOwner = 0& C.lpCustColors = VarPtr(CustomColors(0)) C.rgbResult = DefaultColor C.flags = CC_RGBINIT Or CC_FULLOPEN ' appel la routine Choose Color COMMDLG Result = ChooseColor(C) ' en cas d'erreur If Result = 0 And CommDlgExtendedError() <> 0 Then ChooseColorDlg = -1 MsgBox Str$(CommDlgExtendedError()), 16, "Choose Color Error" End If ' Return the selected color ChooseColorDlg = C.rgbResult End Function Private Sub Command1_Click() Dim i As Integer ' rempli le tableau des couleurs personalisées aléatoirement For i = 0 To UBound(CustomColors) CustomColors(i) = vbWhite * Rnd Next End Sub Private Sub Command2_Click() Me.BackColor = ChooseColorDlg(Me.BackColor) End Sub '******************************************************************** ' MODULE DE DECLARATION : Module1.bas ' plus d'info voir win32.hlp '******************************************************************** Option Explicit 'Structure ChooseColor Type ChooseColor lStructSize As Long hwndOwner As Long hInstance As Long rgbResult As Long lpCustColors As Long flags As Long lCustData As Long lpfnHook As Long lpTemplateName As String End Type Global Const CC_RGBINIT = &H1 'force l'initilaisation de la couleur à l'ouverture de la boite de dialogue Global Const CC_FULLOPEN = &H2 Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (ByRef pChoosecolor As ChooseColor) As Long Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.