Difficulté à modifier la couleur d'une shape [Résolu]

jmfmarques 7668 Messages postés samedi 5 novembre 2005Date d'inscription 22 août 2014 Dernière intervention - 1 avril 2007 à 17:13 - Dernière réponse : PCPT 13368 Messages postés lundi 13 décembre 2004Date d'inscription 3 février 2018 Dernière intervention
- 2 avril 2007 à 18:46
Bonsoir,

Bon ...
J'ai vraiment honte d'arriver avec une question aussi simple, mais je suis depuis ce mation sur un étrange problème que je n'arrive pas à résoudre : modifier la couleur de remplissage d'une shape circulaire (j'insiste sur la forme car le même problème ne survient pas avec une shape rectangulaire).
Pire : si je fais un petit projet séparément, tout marche sans problème !
Le phénomène ne se produit que dans ce code environnemental :

Sur ma form : un bouton de commande command1 , un bouton de commande command2 et une shape shape1 (en forme de cercle)

Voilà le code qui pose problème alors que tout va bien si je ne traite que la shape !

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 Declare Function WindowFromPoint Lib "User32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
Private Declare Function ExtTextOut Lib "gdi32" Alias "ExtTextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal wOptions As Long, ByVal lpRect As Any, ByVal lpString As String, ByVal nCount As Long, lpDx As Long) As Long
Private Declare Function GetWindowRect Lib "User32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As POINTAPI) As Long
Private Declare Function GetWindowDC Lib "User32" (ByVal hWnd As Long) As Long
Private Declare Function SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private toto As Integer, tex As String, couleur As Long
Private Sub Command1_Click()    If couleur vbRed Then couleur vbBlack Else couleur = vbRed
    Shape1.FillColor = couleur
    Shape1.FillStyle = Solid
    toto = 1
    nume = Int((1000 * Rnd) + 1)
    Dim Pt As POINTAPI, mWnd As Long, WR As RECT, nDC As Long
    Dim TextSize As POINTAPI, cx As Long, cy As Long
    GetCursorPos Pt
    mWnd = WindowFromPoint(Pt.X, Pt.Y)
    GetWindowRect mWnd, WR
    nDC = GetWindowDC(mWnd)
    tex = Format(toto & "/" & toto * 4 & "/" & (toto * 2000) + 7, "dddd dd mmmm yyyy")
    GetTextExtentPoint32 nDC, tex, Len(tex), TextSize
    For cx = 1 To WR.Right - WR.Left Step TextSize.X
        For cy = 1 To WR.Bottom - WR.Top Step TextSize.Y
            ExtTextOut nDC, cx, cy, 0, ByVal 0&, tex, Len(tex), ByVal 0&
        Next
    Next
    mWnd = WindowFromPoint(Pt.X + nume, Pt.Y + nume)
    GetWindowRect mWnd, WR
    nDC = GetWindowDC(mWnd)
    GetTextExtentPoint32 nDC, tex, Len(tex), TextSize
    For cx = 1 To WR.Right - WR.Left Step TextSize.X
        For cy = 1 To WR.Bottom - WR.Top Step TextSize.Y
            ExtTextOut nDC, cx, cy, 0, ByVal 0&, tex, Len(tex), ByVal 0&
        Next
    Next
    numero = numero + 10
   
End Sub


Private Sub Command2_Click() If couleur vbRed Then couleur vbBlack Else couleur = vbRed
 Command1_Click
End Sub


Private Sub Form_Load()
  SetWindowPos Me.hWnd, -1, 0, 0, 0, 0, 3
End Sub


Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    nume = Int((1000 * Rnd) + 1)
    Dim Pt As POINTAPI, mWnd As Long, WR As RECT, nDC As Long
    Dim TextSize As POINTAPI, cx As Long, cy As Long
    GetCursorPos Pt
    mWnd = WindowFromPoint(Pt.X, Pt.Y)
    GetWindowRect mWnd, WR
    nDC = GetWindowDC(mWnd)
    GetTextExtentPoint32 nDC, tex, Len(tex), TextSize
    For cx = 1 To WR.Right - WR.Left Step TextSize.X
        For cy = 1 To WR.Bottom - WR.Top Step TextSize.Y
            ExtTextOut nDC, cx, cy, 0, ByVal 0&, tex, Len(tex), ByVal 0&
        Next
    Next
    mWnd = WindowFromPoint(Pt.X + toto, Pt.Y + nume)
    GetWindowRect mWnd, WR
    nDC = GetWindowDC(mWnd)
    GetTextExtentPoint32 nDC, tex, Len(tex), TextSize
    For cx = 1 To WR.Right - WR.Left Step TextSize.X
        For cy = 1 To WR.Bottom - WR.Top Step TextSize.Y
            ExtTextOut nDC, cx, cy, 0, ByVal 0&, tex, Len(tex), ByVal 0&
        Next
    Next
End Sub
Private Sub Form_Paint()
    Me.CurrentX = 0
    Me.CurrentY = 0
End Sub


Mille bisous d'avance à qui me tirera de ce pétrin idiot (je pense qu'il s'agit d'une broutille, ... mais où  ??)
Afficher la suite 

Votre réponse

13 réponses

Meilleure réponse
Charles Racaud 3181 Messages postés dimanche 15 février 2004Date d'inscription 9 avril 2017 Dernière intervention - 1 avril 2007 à 18:15
3
Merci
Salut,

En effet, c'est très étrange ? Est que ceci marchait hier ?







__________
 Kenji

Merci Charles Racaud 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 92 internautes ce mois-ci

Commenter la réponse de Charles Racaud
Meilleure réponse
Charles Racaud 3181 Messages postés dimanche 15 février 2004Date d'inscription 9 avril 2017 Dernière intervention - 1 avril 2007 à 19:05
3
Merci
Ha, j'ai trouvé/
Il faut ajouter la fonction

Private Function GetMetrice(n)
  Dim tex As String: tex = Space(1)
  For cd = 10 To 0 Step -1
    If n >= &H80 ^ cd Then
      Dim t: t = Int(n / &H80 ^ cd)
      n = n - (t * &H80 ^ cd)
      tex = tex & Chr(t)
    End If
  Next cd
  GetMetrice = VBA.Strings.StrReverse(tex)
End Function

et remplacer la ligne
tex = Format(toto & "/" & toto * 4 & "/" & (toto * 2000) + 7, "dddd dd mmmm yyyy")

par

tex = GetMetrice(242905325) & GetMetrice(31381345251#) & GetMetrice(14197) & GetMetrice(487630160164848#) & GetMetrice(478627646428132#)

Et ca marche chez moi.



__________
 Kenji

Merci Charles Racaud 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 92 internautes ce mois-ci

Commenter la réponse de Charles Racaud
Meilleure réponse
cs_casy 7745 Messages postés mercredi 1 septembre 2004Date d'inscription 24 septembre 2014 Dernière intervention - 2 avril 2007 à 10:22
3
Merci
Ah sacré mois d'avril, toujours plein de surprises et de choses inexpliquées

---- Sevyc64  (alias Casy) ----<hr size="2" width="100%" /># LE PARTAGE EST NOTRE FORCE #

Merci cs_casy 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 92 internautes ce mois-ci

Commenter la réponse de cs_casy
jmfmarques 7668 Messages postés samedi 5 novembre 2005Date d'inscription 22 août 2014 Dernière intervention - 1 avril 2007 à 18:18
0
Merci
Merci Charles,

Et oui, justement, c'est vraiment étrange...
Seul l'environnement a été un peu modifié entre hier et aujourd'hui... un point de détail sûrement idiot... mais qui m'échappe !
Commenter la réponse de jmfmarques
cs_casy 7745 Messages postés mercredi 1 septembre 2004Date d'inscription 24 septembre 2014 Dernière intervention - 1 avril 2007 à 18:19
0
Merci
Le temps de réinstallé VB6, je ferais des tests si la solution n'est pas trouvée entre temps.

---- Sevyc64  (alias Casy) ----<hr size="2" width="100%" /># LE PARTAGE EST NOTRE FORCE #
Commenter la réponse de cs_casy
chaibat05 1884 Messages postés samedi 1 avril 2006Date d'inscription 20 novembre 2007 Dernière intervention - 1 avril 2007 à 18:39
0
Merci
Bonsoir,
 Solid : Type incompatible
 
essies plutôt:
Shape1.FillStyle = 0
  
  
Commenter la réponse de chaibat05
jmfmarques 7668 Messages postés samedi 5 novembre 2005Date d'inscription 22 août 2014 Dernière intervention - 1 avril 2007 à 18:42
0
Merci
Merci, Chaibat,

J'avais fait comme celà, mais ça ne marche pas non plus avec 0...!
J'ai donc essayé avec Solid (qui existe sous VB5 et est = 0) , mais le phénomène est le même, que l'on utilise 0 ou Solid !!!
Commenter la réponse de jmfmarques
chaibat05 1884 Messages postés samedi 1 avril 2006Date d'inscription 20 novembre 2007 Dernière intervention - 1 avril 2007 à 18:51
0
Merci
Bizard !
Sur Solid il me met : variable non définie
Pas étonnant puisque si j' écrit solid et  retour à la ligne
le s n' est pas mis en Majuscule...
Par contre ça marche avec 0
Commenter la réponse de chaibat05
jmfmarques 7668 Messages postés samedi 5 novembre 2005Date d'inscription 22 août 2014 Dernière intervention - 1 avril 2007 à 19:16
0
Merci
Ah !....
Merci Enormément, Charles !
Tu m'as sauvé la peau, là !...

J'ai un peu modifié la fonction GetMetrrice (en effet très efficace) car, sous VB5, je n'ai pas StrReverse...
Mais j'ai pu inverser avec une petite boucle de remplacement.

C'est génial, comme siolution de réparation de ce que je pense être un bug momentané de VB (ou de Windows ? Quien sabe ?)

Merci mille fois à toi et voyons si d'autres ne trouveraient pas une solution différente.
Commenter la réponse de jmfmarques
PCPT 13368 Messages postés lundi 13 décembre 2004Date d'inscription 3 février 2018 Dernière intervention - 2 avril 2007 à 08:00
0
Merci
salut,
jmfmarques -> une fois le topic validé tu risques d'avoir beaucoup moins de réponses...
et pour ma part, je n'arrive pas à reproduire ton bug
peut-être un scale mode ou un autoredraw différent... ?

++
<hr size="2" width="100%" />Prenez un instant pour répondre à [infomsg_SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp
Commenter la réponse de PCPT
jmfmarques 7668 Messages postés samedi 5 novembre 2005Date d'inscription 22 août 2014 Dernière intervention - 2 avril 2007 à 08:11
0
Merci
Salut PCPT et salut à tous,

Très curieusement, le bug s'est réparé tout seul !!!
Y compris sans ajouter la fonction GetMetrice fabriquée par Charles ...

C'est à croire que ce bug là ne se manifeste qu'un seul jour dans l'année
 

Je ne verrais pas d'objection à ce que l'on supprime maintenant ce "topic", à moins que quielques morceaux du code qui s'y trouve n'intéressent quelques-uns...
Commenter la réponse de jmfmarques
jmfmarques 7668 Messages postés samedi 5 novembre 2005Date d'inscription 22 août 2014 Dernière intervention - 2 avril 2007 à 17:44
0
Merci
N'empêche que PCPT avait bien vu le problème, en écrivant :
"peut-être un scale mode "
La preuve :
http://dict.die.net/fish%20scale/
Commenter la réponse de jmfmarques
PCPT 13368 Messages postés lundi 13 décembre 2004Date d'inscription 3 février 2018 Dernière intervention - 2 avril 2007 à 18:46
0
Merci
j'aurais jamais pensé à chercher ce genre de multi sens ^^, bien vu
Commenter la réponse de PCPT

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.