API Rectangle et scaleRésolu

Question

Bonjour,
cela fait plusieurs jours que je tourne en rond sur un problème de print preview sur la base de l'exemple suivant : http://support.microsoft.com/kb/193379/fr 
J'ai modifié ce code pour qu'il travaille en pixels afin d'utiliser les API que je préféère largement au Line, print de VB.

peut être pourrez-vous m'aider sur l'un de mes nombreux problèmes. J'ai créé une fonction DrawRectangle(hdc, X, Y, width, height....) mais dans ce cas :

for n ...
   'draw API
   DrawRectangle2 picture1.hdc, X1, Y1, m, 200, vbBlue, vbBlue
   'draw VB
   picture1.Line (X1, Y2)-Step(m, 200), vbRed, B
next 

Cependant un décalage existe systématiquement avec API. comme si il ne respecté par le picture scale que j'ai défini... Est-ce la cas ?

jmfmarques · Accepted Answer

Je serai surtout d'accord sur un point très clair : l'utilisation directe des fonctions de l'API est toujours plus rapide à l'exécution.

Pour le reste : non ! les fonctions graphiques de l'Api de Windows utilisent presque toujours les unités logiques définies pour le

contexte de Device utilisé.... et les coordonnées se calculent toujours par rapport au coin supérieur gauche.

jmfmarques · Answer

Bonjour,

et si tu nous montrais le code incriminé, à savoir celui de ta routine (car ce n'est apparemment pas une fonction mais une routine) DrawRectangle2 ?

on verrait peut-être, alors ...

peug · Answer

voili


Public Sub DrawRectangle2(ByRef hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal lWidth As Long, ByVal lHeight As Long, _
                        ByVal BackColor As Long, ByVal ColorLine As Long, ByVal Ratio As Double)
    Dim lpPoint(5) As POINTAPI
    Dim lRectbrush As Long
    Dim lholdRectbrush As Long
    Dim lrec As Long
    
    X1 = ConvertTwipsToPixels(hDC, X1 * Ratio, 0)
    Y1 = ConvertTwipsToPixels(hDC, Y1 * Ratio, 1)
    lWidth = ConvertTwipsToPixels(hDC, lWidth * Ratio, 0)
    lHeight = ConvertTwipsToPixels(hDC, lHeight * Ratio, 1)



    lpPoint(0).x X1: lpPoint(0).y Y1    lpPoint(1).x X1 + lWidth: lpPoint(1).y Y1    lpPoint(2).x X1 + lWidth: lpPoint(2).y Y1 + lHeight    lpPoint(3).x X1:: lpPoint(3).y Y1 + lHeight
    lpPoint(4) = lpPoint(0)
     
    'Crée un brush Solide et rempli
    lRectbrush = CreatePen(0, 1, ColorLine)

    'Mémorise la brush utilisé par défaut du hDC courant
    lholdRectbrush = SelectObject(hDC, lRectbrush)
    
    'Desine le rectangle plein
    lrec = Polygon(hDC, lpPoint(0), UBound(lpPoint))
    
    'Restauration
    lrec = SelectObject(hDC, lholdRectbrush)
    lrec = DeleteObject(lRectbrush)
end sub

Private Function ConvertTwipsToPixels(ByVal lhdc As Long, ByVal lTwips As Long, ByVal lDirection As Long) As Long
    ' http://support.microsoft.com/kb/210590/fr
    Dim lPixelsPerInch As Long
    
    If (lDirection = 0) Then
        lPixelsPerInch = GetDeviceCaps(lhdc, LOGPIXELSX)
    Else
        lPixelsPerInch = GetDeviceCaps(lhdc, LOGPIXELSY)
    End If



    ConvertTwipsToPixels = lTwips / 1440 * lPixelsPerInch
end if

jmfmarques · Answer

Redonne ton code (le 1er) car il est incomplet, déjà  :

DrawRectangle2 picture1.hdc, X1, Y1, m, 200, vbBlue, vbBlue

envoie 7 paramètres

et

DrawRectangle2(ByRef hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal lWidth As Long, _
ByVal lHeight As Long, ByVal BackColor As Long, ByVal ColorLine As Long, ByVal Ratio As Double)

Je ne vois par ailleurs pas pourquoi tu fais les frais de Polygon alors que l'API de windows t'offre du plus simple pour un rectangle !

jmfmarques · Answer

Tiens,

Mets ce petit bout de code dans un mini projet, lance, regarde, analyse, comprends et sers-t-en ayi lieu de ta fonction Polygon.

Const PS_DOT = 2
Const PS_SOLID = 0
Const RGN_AND = 1
Const RGN_COPY = 5
Const RGN_OR = 2
Const RGN_XOR = 3
Const RGN_DIFF = 4
Const HS_DIAGCROSS = 5
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long


Private Sub Form_Activate()
   Me.ScaleMode = vbPixels
   Me.AutoRedraw = True
   Me.Move 0, 0, Screen.Width, Screen.Height
   Dim hRPen As Long
    hRPen = CreatePen(PS_SOLID, 3, vbBlue)
    DeleteObject SelectObject(Me.hdc, hRPen)
    Rectangle Me.hdc, 200, 200, 800, 600
    DeleteObject hRPen
End Sub

jmfmarques · Answer

et maintenant, ajoute ceci entre DeleteObject hRPen et End Sub

   Me.DrawWidth = 3
    Me.Line (200, 200)-(800, 600), vbRed, B

et lance à nouveau

jmfmarques · Answer

Plus là ?
Dommage !
Tu aurais remarqué un léger débordement du rouge, en bas et à gauche.
Celà est un minuscule bug de VB (pas de l'Api de Windows) en te rappelant que le rouge, vient de l'utilisation de la méthode Line et par de la fonction rectangle...
VB se trompe d'un pixel (dieu sait pourquoi) 
corrigeons donc VB :
Me.Line (200, 200)-(800, 600), vbRed, B  ===>>> Me.Line (200, 200)-(800-1, 600-1), vbRed, B
et la superposition sera parfaite !
A NOTER : nopus avions là une épaisseur de 3 et nous avons corrigé de 1. La correction (1) serait la même avec n'importe quelle autre épaisseur de trait

jmfmarques · Answer

Correction :
Tu aurais remarqué un léger débordement du rouge, en bas et à droite

peug · Answer

Merci,


J'utilise le polygon car il ne crée pas de débord contrainement à l'API Rectangle ! un peu comme le me.Line.
par rapport à ma question initiale, j'ai constaté que le dessin via API ne respecté par la scale appliqué à un object. Ce qui maintenant me semble presque normale. Le méthode LINE, CIRCLE propre à VB  se cale sur le scale de l'objet. L'envoie sur un hdc de API-rectangle passe au dessus de cela et dessine sur le hdc indiqué... 
J'utilise  les API par rapport au line de VB car elles donnent beaucoup plus de possiblité (sans parler de GDI+) VB reste "basic" sans API.

Renfield · Answer

ne jamais dire "jamais", mais ne jaais dire "toujours" non plus ^^

"les coordonnées se calculent toujours par rapport au coin supérieur gauche"
tout dépend du repère que tu utilise....

voir l'API SetViewport, par exemple ^^

Renfield
Admin CodeS-SourceS- MVP Visual Basic

peug · Answer

Renfield, tu as toujours la classe de nous épater :-)
j'ai donc trouvé cela  a propos de SetViewport c'est facinant : http://edais.mvps.org/Tutorials/GDI/DC/DCch8.html

Renfield · Answer

ah... les transformations, interessant, hein ^^

merci peug... ca fait plaisir :p

Renfield
Admin CodeS-SourceS- MVP Visual Basic

API Rectangle et scale

12 réponses

Votre réponse

Discussions similaires