IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

probleme de conversion point to pixel (api gdi32)


Sujet :

Macros et VBA Excel

  1. #1
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut probleme de conversion point to pixel (api gdi32)
    bonjour a tous

    j'ai un souci avec ce code apparament il fonctionne mais la conversion point to pixel ne semble pas fonctionner
    en effet le decoupage se fait bien mais les proportions ne sont pas bonnes
    si quelqu'un a une idée je suis preneur

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
     
    'patricktoulon
    'module pour faire un trou en forme rectangle dans un userform sur la base d'un control
     
    '"""""""""""""""""""""""""""""""""""""""""""""""""
    'dans le module userform
    'Private Sub UserForm_Activate()
    'decoupage Me
    'End Sub
    '""""""""""""""""""""""""""""""""""""""""""""""""""
     
    ' Régions rectangulaires :
    Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    ' Fonction permettant d'associé plusieurs régions :
    Declare Function CombineRgn Lib "gdi32" (ByVal hdestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
    ' Fonction permettant d'appliquer les régions sur une form :
    Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
    'Fonction permettant de libérer la mémoire :
    Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    'fonction permetant de determiner le handle de la form
    Public Declare Function fwa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
     
    Public handle As Long
     
    '// Constantes d'opérateurs logiques :
     
    '// ET logique :
    Public Const RGN_AND = 1
    '// OU logique :
    Public Const RGN_OR = 2
    '// OU exclusif :
    Public Const RGN_XOR = 3
    '// Soustraction logique :
    Public Const RGN_DIFF = 4
     
     
    'variable representant les nom de regions
    Public rgnCercle As Variant
    Public rgnBarre As Variant
    Public rgncarré As Variant
    Public rgnFinale As Variant
    Const p_to_pix = (1.33333333333333) 'converti lunité en point vers l'unité en pixel
    Sub decoupage(uf As Object)
     
    handle = fwa(vbNullString, uf.Caption)
    'on crée la region complete
    rgncomplete = CreateRectRgn(0, 0, 300 * p_to_pix, 300 * p_to_pix)
     
    'on crée la region qui sera decoupée sur la base du label1 en appliquant le p to pix , _
    chiffre multiplicateur pour convertir  les dimentions de point  en pixels
     
    rgncarré = CreateRectRgn(uf.Label1.Left * p_to_pix, uf.Label1.Top * p_to_pix, _
    uf.Label1.Width * p_to_pix, uf.Label1.Height * p_to_pix)
     
    '// On crée la zone principale :celle ci sera identique au userform
    rgnFinale = rgncomplete
     
    '// On combine toutes les zones :le chiffre 3 corespond au mode exclusif
    CombineRgn rgncomplete, rgncarré, rgnFinale, RGN_XOR
     
    '// On associe la région combinée à la form :
    SetWindowRgn handle, rgnFinale, True
     
    'on vide la memoire des variable regions
    DeleteObject rgnFinale
    DeleteObject rgncarré
    DeleteObject rgncomplete
    End Sub
    merci d'avance

    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  2. #2
    pgz
    pgz est déconnecté
    Expert confirmé Avatar de pgz
    Homme Profil pro
    Développeur Office VBA
    Inscrit en
    Août 2005
    Messages
    3 692
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 72
    Localisation : France

    Informations professionnelles :
    Activité : Développeur Office VBA
    Secteur : Conseil

    Informations forums :
    Inscription : Août 2005
    Messages : 3 692
    Par défaut
    Bonjour Patrick.

    Je crois que la conversion en pixels est toujours délicate car elle dépend du nombre de twips qui varie d'une machine à l'autre et qui est généralement différent en X et en Y.

    Regarde les méthodes
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    Window.PointsToScreenPixelsX
    Window.PointsToScreenPixelsY
    Bien cordialement,

    PGZ

  3. #3
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    bonjour pgz

    heuh... oui c'est quoi ces variable ou les prend tu dans une api ?

    si oui la quelle
    et puis point toscreen pixel sa me donnerais la dimention de l'ecran et non pas la conversion enfin je ne connais pas ces variables

    d'autre precisions me serait utiles


    merci a toi pour le coup de mains

    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  4. #4
    Expert confirmé
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    4 128
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 45
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2002
    Messages : 4 128
    Par défaut
    Salut
    Le problème ne vient pas de ta conversion, mais de ta définition de région de ton Label, Y2 et X2 ne valent pas juste la heuteur et largeur de ton label, il faut aussi tenir compte de sa position top et left.
    Comme ca
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    'patricktoulon
    'module pour faire un trou en forme rectangle dans un userform sur la base d'un control
     
    '"""""""""""""""""""""""""""""""""""""""""""""""""
    'dans le module userform
    'Private Sub UserForm_Activate()
    'decoupage Me
    'End Sub
    '""""""""""""""""""""""""""""""""""""""""""""""""""
     
    ' Régions rectangulaires :
    Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    ' Fonction permettant d'associé plusieurs régions :
    Declare Function CombineRgn Lib "gdi32" (ByVal hdestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
    ' Fonction permettant d'appliquer les régions sur une form :
    Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
    'Fonction permettant de libérer la mémoire :
    Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    'fonction permetant de determiner le handle de la form
    Public Declare Function fwa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
     
    Public handle As Long
     
    '// Constantes d'opérateurs logiques :
     
    '// ET logique :
    Public Const RGN_AND = 1
    '// OU logique :
    Public Const RGN_OR = 2
    '// OU exclusif :
    Public Const RGN_XOR = 3
    '// Soustraction logique :
    Public Const RGN_DIFF = 4
     
     
    'variable representant les nom de regions
    Public rgnCercle As Variant
    Public rgnBarre As Variant
    Public rgncarré As Variant
    Public rgnFinale As Variant
    Const p_to_pix = 0.75 'converti lunité en point vers l'unité en pixel
    Sub decoupage(uf As Object)
     
    handle = fwa(vbNullString, uf.Caption)
    'on crée la region complete
    rgncomplete = CreateRectRgn(0, 0, 300 / p_to_pix, 300 / p_to_pix)
     
    'on crée la region qui sera decoupée sur la base du label1 en appliquant le p to pix , _
    chiffre multiplicateur pour convertir  les dimentions de point  en pixels
     
    rgncarré = CreateRectRgn(uf.Label1.Left / p_to_pix, uf.Label1.Top / p_to_pix, _
    (uf.Label1.Width + uf.Label1.Left) / p_to_pix, (uf.Label1.Height + uf.Label1.Top) / p_to_pix)
     
    '// On crée la zone principale :celle ci sera identique au userform
    rgnFinale = rgncomplete
     
    '// On combine toutes les zones :le chiffre 3 corespond au mode exclusif
    CombineRgn rgncomplete, rgncarré, rgnFinale, RGN_XOR
     
    UserForm1.Show False
    '// On associe la région combinée à la form :
    SetWindowRgn handle, rgnFinale, True
     
    'on vide la memoire des variable regions
    DeleteObject rgnFinale
    DeleteObject rgncarré
    DeleteObject rgncomplete
    Au passage, pour être passé a coté il y a quelques temps, au lieu de multiplier par 1.333333..., il est préférable de diviser par 0.75 (1/0.75 = 1.33333...)

    Tu auras un dernier truc a gérer c'est la bordure et le bandeau haut de ton userform qu'il faudra intégrer a tes calcul de position, tu vas vite voir en exécutant le code.

    Il existe en effet d'autre méthodes de conversion, plus exact que /0.75, mais je ne les maîtrise pas (plus), je les ai utilisé en VB4 pour faire joujou avec les régions moi aussi il y a quelques années.
    J'avais même fait un code (monstrueux d'autant que je me souvienne) qui suivait les pixels d'une forme dessiné en N&B dans un Bmp et créer la région correspondante, je peux peut être le retrouver si ça t’intéresse.

    [Edit]
    Bon je retrouve plus mes vieux projets vb , ils sont peut être sur un cd dans un coin, mais j'ai vu des méthodes supers intéressantes sur le woueb, surtout une, elle n'est pas codé en vb par contre.
    La personne par d'une image en N&B, la zone à supprimer est en noir par exemple, il lit l'image ligne par ligne (scanline en vb je crois) il prend en compte les pixels noir et forme des régions rectangulaires de pixels isolés ou de pixels consécutifs. Il regroupe ensuite toutes ces régions dans une régions global. La zone en noir de l'image devient donc la région qui sera appliqué a ton objet. En écrivant ça je me demande si y'a pas une fonction qui fait ça dans les API... Mask... quelque chose
    [/Edit]
    ++
    Qwaz

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  5. #5
    pgz
    pgz est déconnecté
    Expert confirmé Avatar de pgz
    Homme Profil pro
    Développeur Office VBA
    Inscrit en
    Août 2005
    Messages
    3 692
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 72
    Localisation : France

    Informations professionnelles :
    Activité : Développeur Office VBA
    Secteur : Conseil

    Informations forums :
    Inscription : Août 2005
    Messages : 3 692
    Par défaut
    Bonsoir,

    Citation Envoyé par patricktoulon Voir le message
    heuh... oui c'est quoi ces variable ou les prend tu dans une api ?
    Dans la bibli Excel, il y a une classe Window qui a les méthodes en question.
    Voici un bout de code qui illustre le truc
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    With ActiveWindow
        .Zoom = 50
        Range("A1") = "Zoom 50 : " & .PointsToScreenPixelsX(1) & " x " & .PointsToScreenPixelsY(1)
     
        .Zoom = 100
        Range("A2") = "Zoom 100 : " & .PointsToScreenPixelsX(1) & " x " & .PointsToScreenPixelsY(1)
     
    End With
    ce qui affiche
    Zoom 50 : 22 x 180
    Zoom 100 : 27 x 186
    C'est pour illustrer le pb de conversion en pixels.

    Cordialement,

    PGZ

  6. #6
    Expert confirmé
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    4 128
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 45
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2002
    Messages : 4 128
    Par défaut
    Salut
    Si mes souvenirs sont bons, c'est même pour cette raison que Visual Basic (pas le Application) utilisait comme unité le Twips, cette unité n’était pas fonction du nombre de pixel par cm et pour convertir en pixel, il fallait utiliser une constante, qui fournissait le nombre de Twips de l'écran (hauteur et largeur) et l'utiliser pour faire le ratio en fonction du nombre de pixels affichés sur l'écran (hauteur et largeur également) .... enfin je suis pas sur à 100%, faudrait faire quelques recherches
    ++
    Qwaz

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  7. #7
    pgz
    pgz est déconnecté
    Expert confirmé Avatar de pgz
    Homme Profil pro
    Développeur Office VBA
    Inscrit en
    Août 2005
    Messages
    3 692
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 72
    Localisation : France

    Informations professionnelles :
    Activité : Développeur Office VBA
    Secteur : Conseil

    Informations forums :
    Inscription : Août 2005
    Messages : 3 692
    Par défaut
    Salut Quaz.

    Voir sur msdn, conversions des unités Twips, ...
    Extrait
    Voici deux tableaux de conversion des unités de mesure utilisées pour la
    manipulation des coordonnées graphiques ou des polices de caractères.

    Dans chacun de ces tableaux, l'abréviation TP désigne le nombre de Twips
    par Pixel qui est la mesure couramment employée pour indiquer la
    résolution video utilisée ainsi que celle d'une imprimante: il s'agit
    donc d'une unité dépendante du périphérique. On distingue la résolution
    horizontale et la résolution verticale: par exemple 640*480, 800*600.
    Sous Visual Basic, on obtient ces valeurs respectivement par
    [Screen|Printer].TwipsPerPixelX et [Screen|Printer].TwipsPerPixelY.


    Tableau de correspondance entre Twips, Point, Pouce, millimètre et Pixel:

    |Twips Point Pouce mm Pixel
    Twips |1 1/20 1/1440 25.4/1440 1/TP
    Point |20 1 1/72 25.4/72 20/TP
    Pouce |1440 72 1 25.4 1440/TP
    mm |1440/25.4 72/25.4 1/25.4 1 1440/TP*25.4

    Pixel |TP TP/20 TP/1440 25.4*TP/1440 1
    Voilà.

    Mais dans Excel, encore une fois, on a la méthode PointsToScreenPixelsX (ou Y) de l'objet Window. Sinon, c'est
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Screen.TwipsPerPixelX (ou Y)
    Cordialement,

    PGZ

  8. #8
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    bonjour pgz et quazerty

    merci pour vos réponses je vais étudier ca

    et oui je sais il y a même un module classe qui fait ca et plus dans les tutos c'est celui de ARKHAM (le gdiplus), mais mon intérêt avant tout c'est de comprendre le principe


    pour qwazerty:
    je comprend pas très bien ta remarque sur le fait d'utiliser le left et le top
    dans ma macro j'utilise le left,le top,le width,le height du label1 en le convertissant en pixel
    et oui je savais pour le( "/0.75) j'ai même dépose un contrib sur le sujet
    ""comment connaître les dimension de l'écran"" et je l'utilise dans ce sujet

    bon allez je bûche et je reviens
    merci a tout les deux

    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  9. #9
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    re

    ok j'ai compris encore une fois qwazerty tu a raison

    pour le top et le left c'est bon pour le width et le height il faut prendre en compte la position du userform
    et pour la barre effectivement il faut ajouter au top le height de la caption
    soit 25 pour moi


    je te remercie

    je pointe resolu et je retourne tout de suite dessus pour bien assimiler

    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  10. #10
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    je reviens une derniere fois sur ce sujet

    voila la macro correcte:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
     
    'patricktoulon
    'module pour faire un trou en forme rectangle dans un userform sur la base d'un control
     
    '"""""""""""""""""""""""""""""""""""""""""""""""""
    'dans le module userform
    'Private Sub UserForm_Activate()
    'decoupage Me
    'End Sub
    '""""""""""""""""""""""""""""""""""""""""""""""""""
     
    ' Régions rectangulaires :
    Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    ' Fonction permettant d'associé plusieurs régions :
    Declare Function CombineRgn Lib "gdi32" (ByVal hdestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
    ' Fonction permettant d'appliquer les régions sur une form :
    Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
    'Fonction permettant de libérer la mémoire :
    Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    'fonction permetant de determiner le handle de la form
    Public Declare Function fwa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
     
    Public handle As Long
     
    '// Constantes d'opérateurs logiques :
     
    '// ET logique :
    Public Const RGN_AND = 1
    '// OU logique :
    Public Const RGN_OR = 2
    '// OU exclusif :
    Public Const RGN_XOR = 3
    '// Soustraction logique :
    Public Const RGN_DIFF = 4
     
     
    'variable representant les nom de regions
    Public rgnCercle As Variant
    Public rgnBarre As Variant
    Public rgncarré As Variant
    Public rgnFinale As Variant
    Const p_to_pix = 0.75 'converti lunité en point vers l'unité en pixel
    Const decalage = 3 'pour le decalage provoquer par l'epaissuere des bordures sur les coté du userform
    Const epaisseurbarre = 25 'il faut aussi ajouter ala formule ducalcule l'epaisseur de la barre pour la simple et bonne raison que le point 0 du  top se trouve juste en dessous de celle ci( a l'interrieur) 
    Sub decoupage(uf As Object)
     
    handle = fwa(vbNullString, uf.Caption)
    'on crée la region complete
    rgncomplete = CreateRectRgn(0, 0, 300 / p_to_pix, 300 / p_to_pix)
     
    'on crée la region qui sera decoupée sur la base du label1 en appliquant le p to pix , _
    chiffre multiplicateur pour convertir  les dimentions de point  en pixels
     
    rgncarré = CreateRectRgn((uf.Label1.Left / p_to_pix) + decalage, (uf.Label1.Top / p_to_pix) + epaisseurbarre, _
    ((uf.Label1.Width + uf.Label1.Left) / p_to_pix) + decalage, ((uf.Label1.Height + uf.Label1.Top) / p_to_pix) + epaisseurbarre)
     
    '// On crée la zone principale :celle ci sera identique au userform
    rgnFinale = rgncomplete
     
    '// On combine toutes les zones :le chiffre 3 corespond au mode exclusif
    CombineRgn rgncomplete, rgncarré, rgnFinale, RGN_XOR
     
    UserForm1.show False
    '// On associe la région combinée à la form :
    SetWindowRgn handle, rgnFinale, True
     
    'on vide la memoire des variable regions
    DeleteObject rgnFinale
    DeleteObject rgncarré
    DeleteObject rgncomplete
    End Sub
    donc la formule pour calculer la position du label1 :

    top en pixel=( label1.top/0.75)+l'epaisseur de la caption du userform

    left en pixel=( label1.left/0.75)+l'epaisseur du cadre de l' userform

    width en pixel=((largeur du label1+ position gauche du label1) / 0.75) + l'epaisseur du cadrede l' userform

    height=((hauteur du label1+ position top du label1) / 0.75) + l'epaisseur de la caption du userform



    voila si ca peut servir

    merci a toi qwazerty

    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  11. #11
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    le revoila un peu plus propre et éléboré

    il y a maintenant une function qui calcule les coordonnées

    il suffit de metre dans le activate de l'userform l'apell a la fonction suivi de "me" pour l'userform et le nom du control entre guillemets et le tour est joué


    'dans le module userform

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
     
     
    Private Sub UserForm_Activate()
    'appel a la routine decoupage suivi de l'object userform lui meme et du nom du control de reference
    decoupage Me, "Label1"
    End Sub
    et dans un module standard
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
     
    'patricktoulon
    'module pour faire un trou  dans un userform sur la base de la forme  d'un control
     
    Option Explicit
    ' Régions rectangulaires :
    Public Declare Function CreateRegion Lib "gdi32" Alias "CreateRectRgn" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    ' Fonction permettant d'associé plusieurs régions :
    Public Declare Function CombineRegion Lib "gdi32" Alias "CombineRgn" (ByVal hdestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
    ' Fonction permettant d'appliquer les régions sur une form :
     Public Declare Function applique_la_region Lib "user32" Alias "SetWindowRgn" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
    'Fonction permettant de libérer la mémoire :
    Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    'fonction permetant de determiner le handle de la form
    Public Declare Function fwa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    'Fonction permetant d'afficher le userform en plein ecran=3,minimiser=1,normal=2
     
     
    '// Constantes d'opérateurs logiques :
     
    '1=on enleve ce qui'il y a autour du control
    Const autour = 1
    ' 3=on enleve la partie qui correspond au control
    Const dedans = 3
     
    'variable representant les nom de regions
    Public region_du_control, regioncomplete As Long
    'variable representant les dimention et point de depart
    Public largeurUSF, hauteurUSF, placeleft, placetop, largeur, hauteur As Long
    'constante representant des valeurs
    Const p_to_pix = 0.75 'converti l'unité en point vers l'unité en pixel
    Const decalage = 3 ' l'epaisseur du cadre de l'userform
    Const epaisseurbarre = 25 ' l'epaisseur de la caption de l'userform
    'variable pour le handle de l'userform
    Public handle As Long
     
    Public Function decoupage(uf As Object, ctrl As String)
    handle = fwa(vbNullString, uf.Caption) 'on determine le handle
     
     
     'appelle la routine qui va calculer les dimentions et l'emplacement en pixels du control de reference
     pointopixel uf, uf.Controls(ctrl).Name
     
    'on crée la region complete
     
    ''''''''''''''''''''''''''''''(le left en pixel, le top en pixel, largeurUSFen pixel, hauteurUSFen pixel) 'le top a 25 si on veut supprimer la caption
    regioncomplete = CreateRegion(0, 0, largeurUSF, hauteurUSF) 'le top a 25 pour couper la caption de l'userform
     
    'on crée la region qui sera decoupée avec les variables qui ont été renseignées dans la routine pointopixel représentant les dimensions en pixel
    region_du_control = CreateRegion(placeleft, placetop, largeur, hauteur)
     
    '// On combine toutes les zones :le chiffre 3 corespond au mode exclusif
    CombineRegion regioncomplete, region_du_control, regioncomplete, dedans
     
    '// On associe la région combinée à la form :
    applique_la_region handle, regioncomplete, True
     
    'on vide la memoire des variable regions
    DeleteObject region_du_control
    DeleteObject regioncomplete
     
    End Function
     
     
    Public Function pointopixel(usf As Object, ctrl As String)
    placeleft = (usf.Controls(ctrl).Left / p_to_pix) + decalage 'on determine la position gauche du control de reference
    placetop = (usf.Controls(ctrl).Top / p_to_pix) + epaisseurbarre ''on determine la position top du control de reference
    largeur = ((usf.Controls(ctrl).Width + usf.Controls(ctrl).Left) / p_to_pix) + decalage 'on determine la largeur du control de reference
    hauteur = ((usf.Controls(ctrl).Height + usf.Controls(ctrl).Top) / p_to_pix) + epaisseurbarre 'on determine la hauteur du control de reference
    largeurUSF = usf.Width / p_to_pix
    hauteurUSF = usf.Height / p_to_pix
    End Functio
    merci qwazerty pour ton aide


    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  12. #12
    Expert confirmé
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    4 128
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 45
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2002
    Messages : 4 128
    Par défaut
    Salut
    Juste 2 petites choses

    1. Attention à tes déclarations de variables

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Public largeurUSF, hauteurUSF, placeleft, placetop, largeur, hauteur As Long
    VBA lui comprend
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Public largeurUSF As Variant, hauteurUSF As Variant, placeleft As Variant, placetop As Variant, largeur As Variant, hauteur As Long
    Il faut répeter le type a chaque variable

    1. Pour la fonction j'aurais plutôt fait un truc comme ça, pour éviter d'avoir des variables a portées module qui servent juste a passer des paramètres d'une fonction a l'autre.


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    Public Function PoinToPixel(ctrl As Object, DecalageX As Integer, DecalageY As Integer) As Rect
    With PoinToPixel
        .Left = ctrl.Left / p_to_pix + DecalageX 'on determine la position gauche du control de reference
        .Top = ctrl.Top / p_to_pix + DecalageY ''on determine la position top du control de reference
        .Right = (ctrl.Width + ctrl.Left) / p_to_pix + DecalageX 'on determine la largeur du control de reference
        .Bottom = (ctrl.Height + ctrl.Top) / p_to_pix + DecalageY 'on determine la hauteur du control de reference
    End With
    'Tu fais un autre appelle a PointToPixel dans ton code de départ avec comme ctrl le UserForm
    'largeurUSF = usf.Width / p_to_pix
    'hauteurUSF = usf.Height / p_to_pix
    End Function
     
    Sub essai()
    Dim T As Rect
    T = PoinToPixel(UserForm1.Label1, 5, 25)
     
    End Sub
    ++
    Qwaz

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  13. #13
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    re
    j'avais tenter un truc du genre mais je ne sais pas pourquoi ctrl en object dans l'enoncer de la fonction buguais j'ai du passer en string et me servir du non et non pas de l'object lui meme

    je vais essayer ton module
    voila une bonne petite contrib apart le gdiplus de arkham il n y en a pas de ce genre

    allez j y retourne
    edit

    heu probleme !....

    ctrl n'est pas reconu puis que je travail dans un module standard et nom pas dans le userform

    tes variable doivent etre modifiée
    et puis pourquoi faire apell deux fois a la fonction autant metre largeur et hauteur usf dedans et ajouter les deux variable dans l'enoncé de la fonction en long enfin je crois

    edit:

    ok je me retrouve donc avec un t.left,t.top,.t.width.,t.height dans la creation du rectangle si j'ai bien compris ta methode
    j apelle essai dans ma macro decoupe a la place de pontopixel
    ai je tort?

    redit:

    voila si j'ai bien compris ton truc

    a la place de:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
     
     
    pointopixel uf, uf.Controls(ctrl).Name
    je met
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     
     essai uf ,uf.Controls(ctrl).Name
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
     
     Sub essai(usf as object,ctrls as string)
    Dim T As Rect
    T = PoinToPixel(usf.controls(ctrls), 5, 25)
    et ala place de
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
     
    'dans la macro decoupe
    region_du_control = CreateRegion(placeleft, placetop, largeur, hauteur)
    je met
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
     
     
     CreateRegion(t.left, t.top, t.width, t.height)
    je n'est pas essayé mais si je resonne logiquement ca doit etre ca

    ai-je tort???


    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  14. #14
    Expert confirmé
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    4 128
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 45
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2002
    Messages : 4 128
    Par défaut
    Salut
    Alors

    Module 1

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    Option Explicit
     
    Public Type Rect
        Top As Integer
        Left As Integer
        Bottom As Integer
        Right As Integer
    End Type
     
    Const p_to_pix = 0.75
     
    Public Function pointopixel(Ctrl As Object, DecalageX As Integer, DecalageY As Integer) As Rect
    With pointopixel
        .Left = Ctrl.Left / p_to_pix + DecalageX 'on determine la position gauche du control de reference
        .Top = Ctrl.Top / p_to_pix + DecalageY ''on determine la position top du control de reference
        .Right = (Ctrl.Width + Ctrl.Left) / p_to_pix + DecalageX 'on determine la largeur du control de reference
        .Bottom = (Ctrl.Height + Ctrl.Top) / p_to_pix + DecalageY 'on determine la hauteur du control de reference
    End With
    'Tu fais un autre appelle a PointToPixel dans ton code de départ avec comme ctrl le UserForm
    'largeurUSF = usf.Width / p_to_pix
    'hauteurUSF = usf.Height / p_to_pix
    End Function
    Module 2
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    'patricktoulon
    'module pour faire un trou  dans un userform sur la base de la forme  d'un control
     
    Option Explicit
    ' Régions rectangulaires :
    Public Declare Function CreateRegion Lib "gdi32" Alias "CreateRectRgn" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    ' Fonction permettant d'associé plusieurs régions :
    Public Declare Function CombineRegion Lib "gdi32" Alias "CombineRgn" (ByVal hdestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
    ' Fonction permettant d'appliquer les régions sur une form :
     Public Declare Function applique_la_region Lib "user32" Alias "SetWindowRgn" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
    'Fonction permettant de libérer la mémoire :
    Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    'fonction permetant de determiner le handle de la form
    Public Declare Function fwa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    'Fonction permetant d'afficher le userform en plein ecran=3,minimiser=1,normal=2
     
     
    '// Constantes d'opérateurs logiques :
     
    '1=on enleve ce qui'il y a autour du control
    Const autour = 1
    ' 3=on enleve la partie qui correspond au control
    Const dedans = 3
     
    'variable representant les nom de regions
    'variable representant les dimention et point de depart
    'Public largeurUSF, hauteurUSF, placeleft, placetop, largeur, hauteur As Long
    'constante representant des valeurs
    Const p_to_pix = 0.75 'converti l'unité en point vers l'unité en pixel
    Const Decalage = 3 ' l'epaisseur du cadre de l'userform
    Const EpaisseurBarre = 25 ' l'epaisseur de la caption de l'userform
    'variable pour le handle de l'userform
    Public handle As Long
     
    Public Function decoupage(ByVal Uf As Object, ByVal Ctrl As Object)
    Dim RectDecoupeLbl As Rect, RectDecoupeUf As Rect
    Dim Region_du_Control As Long, RegionComplete As Long
     
    handle = fwa(vbNullString, Uf.Caption) 'on determine le handle
     
     
     'appelle la routine qui va calculer les dimentions et l'emplacement en pixels du control de reference
     'pointopixel uf.Controls(ctrl).Name
    RectDecoupeLbl = pointopixel(Ctrl, Decalage, EpaisseurBarre)
    RectDecoupeUf = pointopixel(Ctrl.Parent, 0, 0)
    'on crée la region complete
     
    ''''''''''''''''''''''''''''''(le left en pixel, le top en pixel, largeurUSFen pixel, hauteurUSFen pixel) 'le top a 25 si on veut supprimer la caption
    RegionComplete = CreateRegion(0, 0, RectDecoupeUf.Right, RectDecoupeUf.Bottom) 'le top a 25 pour couper la caption de l'userform
     
    'on crée la region qui sera decoupée avec les variables qui ont été renseignées dans la routine pointopixel représentant les dimensions en pixel
    Region_du_Control = CreateRegion(RectDecoupeLbl.Left, RectDecoupeLbl.Top, RectDecoupeLbl.Right, RectDecoupeLbl.Bottom)
     
    '// On combine toutes les zones :le chiffre 3 corespond au mode exclusif
    CombineRegion RegionComplete, Region_du_Control, RegionComplete, dedans
     
    '// On associe la région combinée à la form :
    applique_la_region handle, RegionComplete, True
     
    'on vide la memoire des variable regions
    DeleteObject Region_du_Control
    DeleteObject RegionComplete
     
    End Function
    Tu peux bien sur fusionner les 2 modules

    Utilisation (dans un bouton du UserForm par exemple)
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    Private Sub CommandButton1_Click()
    decoupage Me, Label1
    End Sub
    Et voila
    ++
    Qwaz

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  15. #15
    Expert confirmé
    Avatar de Arkham46
    Profil pro
    Inscrit en
    Septembre 2003
    Messages
    5 865
    Détails du profil
    Informations personnelles :
    Localisation : France, Loiret (Centre)

    Informations forums :
    Inscription : Septembre 2003
    Messages : 5 865
    Par défaut
    Bjr,

    Je n'ai pas pû m'empêcher de mettre ma version :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
     
    Option Explicit
     
    ' Definition des variables non typees en long pour 32 bits ou longptr pour 64 bits
    ' Les elements des types doivent etre types obligatoirement
    #If VBA7 Then
    DefLngPtr A - Z
    Const PtrNull As LongPtr = 0
    #Else
    DefLng A-Z
    Const PtrNull As Long = 0
    #End If
     
    #If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    private Declare PtrSafe Function ClientToScreen Lib "user32" Alias "ClientToScreen" (ByVal hwnd As LongPtr, lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function GetWindowRect Lib "USER32" (ByVal hwnd As LongPtr, lpRect As Rect) As Long
    Private Declare PtrSafe Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As LongPtr
    Private Declare PtrSafe Function CombineRgn Lib "gdi32" (ByVal hDestRgn As LongPtr, ByVal hSrcRgn1 As LongPtr, ByVal hSrcRgn2 As LongPtr, ByVal nCombineMode As Long) As Long
    Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
    Private Declare PtrSafe Function SetWindowRgn Lib "USER32" (ByVal hwnd As LongPtr, ByVal hRgn As LongPtr, ByVal bRedraw As Long) As Long
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetDC Lib "USER32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "USER32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function GetWindowRgn Lib "user32" Alias "GetWindowRgn" (ByVal hWnd As LongPtr, ByVal hRgn As LongPtr) As Long
    Private Declare PtrSafe Function FindWindowEx Lib "USER32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    #Else
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
    Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) 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 Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
    Private Declare Function GetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long) As Long
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    #End If
     
    Private Type POINTAPI
            x As Long
            y As Long
    End Type
    Private Type RECT
            Left As Long
            Top As Long
            Right As Long
            Bottom As Long
    End Type
     
    Private Const RGN_AND = 1
    Private Const RGN_OR = 2
    Private Const RGN_XOR = 3
    Private Const RGN_DIFF = 4
    Private Const RGN_COPY = 5
     
    Private Const LOGPIXELSY = 90
    Private Const LOGPIXELSX = 88
     
    Private Const ERRORAPI = 0
    Private Const NULLREGION = 1
    Private Const SIMPLEREGION = 2
    Private Const COMPLEXREGION = 3
     
    ' Fait un trou dans un formulaire
    ' Le trou est fait à l'emplacement des controls dans pControls
    ' Les contrôles doivent tous appartenir au même formulaire
    ' Ne fonctionne pas pour des contrôles dans un Frame
    Public Function MakeHole(ParamArray pControls() As Variant) As Boolean
    Dim lHwnd, lhDC
    Dim lPt As POINTAPI
    Dim lRect As RECT
    Dim lDecalageX As Long, lDecalageY As Long
    Dim lUserFormRegion, lRegionCtrl
    Dim lpppX As Long, lpppY As Long
    Dim lCpt As Long
    ' Handle du formulaire
    lHwnd = FindWindow(vbNullString, pControls(0).Parent.Caption)
    ' Rectangle contenant le formulaire en coordonnées écran
    GetWindowRect lHwnd, lRect
    ' Convertit 0,0 de la zone client en coordonnées écran
    ClientToScreen lHwnd, lPt
    ' Décalage entre la zone client et la fenêtre userForm
    lDecalageX = lPt.x - lRect.Left
    lDecalageY = lPt.y - lRect.Top
    ' Recherche les points par pouce pour convertion points vers pixels
    lhDC = GetDC(lHwnd)
    lpppX = GetDeviceCaps(lhDC, LOGPIXELSX)
    lpppY = GetDeviceCaps(lhDC, LOGPIXELSY)
    ReleaseDC lHwnd, lhDC
    ' Région vide pour contenir le retour de GetWindowRgn
    lUserFormRegion = CreateRectRgn(0, 0, 0, 0)
    ' Recherche une éventuelle région déjà affectée au formulaire
    If GetWindowRgn(lHwnd, lUserFormRegion) < SIMPLEREGION Then
        ' Si pas de région => supprime la région temporaire
        DeleteObject lUserFormRegion
        ' Et crée une région englobant tout le formulaire
        lUserFormRegion = CreateRectRgn(0, 0, lRect.Right - lRect.Left, lRect.Bottom - lRect.Top)
    End If
    For lCpt = LBound(pControls) To UBound(pControls)
        ' Création d'une région englobant le contrôle pControl
        ' Il y a 72 points dans un pouce et pppX pixels dans un pouce
        lRegionCtrl = CreateRectRgn(lDecalageX + pControls(lCpt).Left * lpppX / 72, _
                                lDecalageY + pControls(lCpt).Top * lpppY / 72, _
                                lDecalageX + (pControls(lCpt).Left + pControls(lCpt).Width) * lpppX / 72, _
                                lDecalageY + (pControls(lCpt).Top + pControls(lCpt).Height) * lpppY / 72)
        ' Combine les régions pour faire le trou
        CombineRgn lUserFormRegion, lUserFormRegion, lRegionCtrl, RGN_DIFF
        ' Supprime la région temporaire
        DeleteObject lRegionCtrl
    Next
    ' Affecte la région au formulaire
    ' MakeHole renvoit True si l'affectation à la région s'est correctement déroulée
    MakeHole = (SetWindowRgn(lHwnd, lUserFormRegion, 1) > 0)
    ' Supprime la région
    DeleteObject lUserFormRegion
    End Function
    La conversion points vers pixels dépend des paramètres du pc, donc je n'ai pas mis 0,75 en constante (le 72 est une vrai constante).
    Pour la taille des bordures et de la barre de titre, ça peut également changer (chez moi j'ai 22 de décalage en y) et provoquer des décalages.
    J'ai tenter de retrouver le décalage fenêtre vers client avec quelques API.

    C'est à priori compatible avec la version 2010 64 bits mais je n'ai pas testé.

    Pour l'utilisation mettre en paramètre de MakeHole autant que contrôles que voulu :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    MakeHole Me.CommandButton2, Me.CommandButton1
    Il est possible d'exécuter la fonction plusieurs fois, ça cumule les trous.
    Il faudrait faire une fonction inverse pour les reboucher.

    J'ai commenté un peu, j'espère que ça vous aidera.
    Bon courage.

  16. #16
    Expert confirmé
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    4 128
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 45
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2002
    Messages : 4 128
    Par défaut
    Salut
    Ben ça va en faite j'y étais "presque"... comme quoi parfois dans un mot, il y a un monde ^^.

    De plus c'est vrai que le 64bits, il va falloir s'y mettre...

    Merci pour le brin de lecture

    ++
    Qwaz

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  17. #17
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    rebonsoir a tous les deux

    hihihihihi bonjour arkham ca m'etonnait de ne pas voir le bout du nez etant donné que tu
    metrise plus que bien le sujet

    j'aurais pu le faire en utilisant ton "gdiplus" mais mon interet et de comprendre comment ca fonctionne vu que je me suis assez amusé avec la user32.dll je m'ataque a la gdi


    pour revenir au sujet la derniere proposition de qwazerty avec les deux appel a pointopixel fonctionne tres bien mais je metrise encore mal tout ca
    mais neanmoins je l'assimile


    en fait tout au long de la discution je me suis rendu compte que finalement le titre de la question n'etait pas le bon puisqu'en fait il falait prendre le right et le bottom pour calculer la region

    maintenant je suis en train de travail sur la combinaison de region j'arrive a en associer deur avec combinergn region1,region2,region1,1,ou2ou3ou4 selon mon souhait

    mais je ne sais pas comment faire pour en associer plus de deux


    un coup de main me serai utile


    merci a tous les deux
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  18. #18
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    pour revenir a la question pour trouver la largeur caption et cadre

    une idée de bricoleur
    j'ai essayé ca marche et effectivement je n'ai pas les memes données sur deux ordis differents

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
      Dim epaisseure_cadre As Long
    epaisseure_cadre = Me.Width - Me.InsideWidth / 2
    'et pour trouver l'epaisseur a enlever sur la hauteur  créer un region prenant en compte tout l'userform
     
    region.Height -Me.InsideWidth + epaisseurcadre

    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  19. #19
    Expert confirmé
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    4 128
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 45
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2002
    Messages : 4 128
    Par défaut
    Salut
    Si tu regardes attentivement le code d'Arkham46 (j'ai d'ailleurs oublié de lui mettre un vote!), tu auras la réponse à ta question.
    Il suffit d'avoir une regions global, et de lui combiner une par une, les regions que tu veux ajouter ou soustraire.
    Regarde ici
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    For lCpt = LBound(pControls) To UBound(pControls)
        ' Création d'une région englobant le contrôle pControl
        ' Il y a 72 points dans un pouce et pppX pixels dans un pouce
        lRegionCtrl = CreateRectRgn(lDecalageX + pControls(lCpt).Left * lpppX / 72, _
                                lDecalageY + pControls(lCpt).Top * lpppY / 72, _
                                lDecalageX + (pControls(lCpt).Left + pControls(lCpt).Width) * lpppX / 72, _
                                lDecalageY + (pControls(lCpt).Top + pControls(lCpt).Height) * lpppY / 72)
        ' Combine les régions pour faire le trou
        CombineRgn lUserFormRegion, lUserFormRegion, lRegionCtrl, RGN_DIFF
        ' Supprime la région temporaire
        DeleteObject lRegionCtrl
    Next
    Arkham46 utilise lUserFormRegion et lui combine lRegionCtrl qui sera différent à chaque boucle, au final tu auras bien dans lUserFormRegion la combinaison de toutes les régions qu'aura representé lRegionCtrl.

    ++
    Qwaz

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  20. #20
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    rebonjour

    j ai regardé le code ARKHAM 46 j'avoue que la je patoge
    et c'est vrai je n'est pas voté moi non plus et j'ai oublié de le feliciter pour les nouveaux apports qu'il a fait dans son tuto a ce sujet
    les exemples supplementaires qu'il a mis dedans sont tout simplement géniaux
    quand a moi
    a savoir je suis sur seven 64 mais je travaille avec office 2007 32 bit
    j'ai bien essayé la release de la version 2010 mais je n'est pas accroché
    edit :
    je viens d'essayer le code il fonctionne parfaitement bien avec plusieur controls
    edit/:
    cela etant dis je me suis mal exprimer quand je parlais de fusioner plusieur regions

    dans mon deuxieme exercice j'ai des regions faites sur la bases de controls et d'autre par des coordonnées
    donc l' exemple d'arkham46 lui créé et fusionnes que des regions sur la bases des controls

    c'est la qu'est la difficulté pour moi je n'est aucunne idée de comment faire

    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

Discussions similaires

  1. probleme de conversion
    Par hay2006 dans le forum VB 6 et antérieur
    Réponses: 3
    Dernier message: 19/12/2005, 10h02
  2. probleme de conversion float en int
    Par murreya dans le forum C++
    Réponses: 2
    Dernier message: 17/12/2005, 15h27
  3. [datapump] probleme de conversion d'une base paradox
    Par plante20100 dans le forum Bases de données
    Réponses: 4
    Dernier message: 04/11/2005, 18h39
  4. Probleme de conversion de dates
    Par manu00 dans le forum Langage
    Réponses: 4
    Dernier message: 29/05/2005, 00h00
  5. [Math][Integer] Problème de conversion
    Par deathwing dans le forum API standards et tierces
    Réponses: 8
    Dernier message: 11/05/2004, 17h01

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo