Afficheur defilant

Description

Me revoici avec la petite sœur de "AFFICHEUR MATRICIEL MODULABLE"

cette source contient un UserCotrol Fait maison permetant de créer un support pour dessiner (Device Context) associé à une gestion du déplacement.

On défini une dimension (Largeur_totale, Hauteur_totale).
Un DC est créé à cette dimension. (par l'intermediaire d'un DIB mais ca c mon problème ^^)
La fenetre possède, de fait une dimension.

Si le DC est plus petit que l'Afficheur, aucun deplacement n'est possible.
Si le DC est plus grand que l'Afficheur, le défilement est automatique si la souris passe au dessus des bordures (de défilement)

On peut définir la bordure de sorte à avoir un dégradé de vitesse de défilement.
Cela permet concrètement de faire en sorte, que au centre le défilement soit lent (Brd_Vit_Min) et augmente en se rapprochant du bord de l'Afficheur (Brd_Vit_Min + Brd_Vit_Pas * index_zone)

l'interret, c'est qu'il ne reste plus que le graphisme à traiter pour les futurs projets.
on utilise des API sur le DeviceContext : AFFICHEUR.DC
une fois le graphisme modifié, on met l'affichage à jour : AFFICHEUR.ReDraw

on peut également utiliser la méthode MiniVue(PictureBox) pour afficher la position de la Zone visible par rapport au DC enier.

le plus simple c'est de lancer mon code, ça sa s'expliquera de soit.

Source / Exemple :


'-------------------------------------------------------------------------------
' les API
'-------------------------------------------------------------------------------
Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Enum FILLMODE
    ALTERNATE = 1
    WINDING = 2
End Enum

Private Enum RGN_COMBINE
    RGN_AND = 1     ' Intersection
    RGN_OR = 2      ' Union
    RGN_XOR = 3     ' Union - Intersection
    RGN_DIFF = 4    ' Rgn1 - Rgn2
    RGN_COPY = 5    ' Clone la Region
End Enum

Private Enum HASH_TYPE
    HS_HORIZONTAL = 0   'Horizontal lines.
    HS_VERTICAL = 1     'Vertical lines.
    HS_FDIAGONAL = 2    'Diagonal lines from the upper-left to the bottom-right.
    HS_BDIAGONAL = 3    'Diagonal lines from the bottom-left to the upper-right.
    HS_CROSS = 4        'Cross pattern of horizontal and vertical lines.
    HS_DIAGCROSS = 5    'Cross pattern of perpendicular diagonal lines.
End Enum

Private Enum PEN_STYLE
    PS_SOLID = 0
    PS_DOT = 2
End Enum

Private Declare Function CreateCompatibleDC Lib "GDI32.dll" (ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "GDI32.dll" (ByVal hDC As Long) As Long

Private Declare Function BitBlt Lib "GDI32.dll" (ByVal hdcDest As Long, ByVal nXDest As Long, ByVal nYDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hdcSrc As Long, ByVal nXSrc As Long, ByVal nYSrc As Long, ByVal dwRop As Long) As Long
    
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal nLeftRect As Long, ByVal nTopRect As Long, ByVal nRightRect As Long, ByVal nBottomRect As Long) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal nLeftRect As Long, ByVal nTopRect As Long, ByVal nRightRect As Long, ByVal nBottomRect As Long, ByVal nWidthEllipse As Long, ByVal nHeightEllipse As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal nLeftRect As Long, ByVal nTopRect As Long, ByVal nRightRect As Long, ByVal nBottomRect As Long) As Long
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function CombineRgn Lib "GDI32.dll" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function FrameRgn Lib "GDI32.dll" (ByVal hDC As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function PaintRgn Lib "gdi32" (ByVal hDC As Long, ByVal hRgn As Long) As Long
Private Declare Function FillRgn Lib "GDI32.dll" (ByVal hDC As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long

Private Declare Function CreatePen Lib "GDI32.dll" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "GDI32.dll" (ByVal crColor As Long) As Long
Private Declare Function CreateHatchBrush Lib "GDI32.dll" (ByVal nIndex As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePatternBrush Lib "GDI32.dll" (ByVal hBitmap As Long) As Long
Private Declare Function GetDCBrushColor Lib "GDI32.dll" (ByVal hDC As Long) As Long
Private Declare Function SetDCBrushColor Lib "GDI32.dll" (ByVal hDC As Long, ByVal crColor As Long) As Long

Private Declare Function SelectObject Lib "GDI32.dll" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "GDI32.dll" (ByVal hObject As Long) As Long
'-------------------------------------------------------------------------------

Option Explicit

Private Sub AFFICHEUR1_DblClick(X As Single, Y As Single)
    Dim Rgn As Long
    Dim Brush As Long
    Dim hBrush As Long
            
    With AFFICHEUR1
        Brush = CreateSolidBrush(vbRed)
        hBrush = SelectObject(.DC, Brush)
        Rgn = CreateEllipticRgn(X - 5, Y - 5, X + 5, Y + 5)
            Call FillRgn(.DC, Rgn, Brush)
        Call DeleteObject(Rgn)
        Call SelectObject(.DC, hBrush)
        Call DeleteObject(Brush)
    
        .ReDraw
    End With
End Sub

Private Sub AFFICHEUR1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    AFFICHEUR1.Enable_Deplacement = False
End Sub

Private Sub AFFICHEUR1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    AFFICHEUR1.Enable_Deplacement = True
End Sub

Private Sub AFFICHEUR1_VueChange()
    Call AFFICHEUR1.MiniVue(P, vbRed, vbGreen)
End Sub

Private Sub Form_Load()
    With AFFICHEUR1
        .Largeur_totale = 1000
        .Hauteur_totale = 1000
        
        Dim Rgn As Long
        Dim Brush As Long
        Dim hBrush As Long
            
        Brush = CreateSolidBrush(vbWhite)
        hBrush = SelectObject(.DC, Brush)
        Rgn = CreateRectRgn(0, 0, .Largeur_totale, .Hauteur_totale)
            Call FillRgn(.DC, Rgn, Brush)
        Call DeleteObject(Rgn)
        Call SelectObject(.DC, hBrush)
        Call DeleteObject(Brush)
        
        Dim T(1 To 4) As POINTAPI
            T(1).X = 0
                T(1).Y = 0
            T(2).X = .Largeur_totale
                T(2).Y = .Hauteur_totale
            T(3).X = .Largeur_totale
                T(3).Y = 0
            T(4).X = 0
                T(4).Y = .Hauteur_totale
        Rgn = CreatePolygonRgn(T(1), 4, 1)
        Brush = CreateSolidBrush(vbBlack)
        hBrush = SelectObject(.DC, Brush)
            Call FrameRgn(.DC, Rgn, Brush, 3, 3)
        Call DeleteObject(Rgn)
        Call SelectObject(.DC, hBrush)
        Call DeleteObject(Brush)
        
        .ReDraw
    End With
End Sub

Conclusion :


Il n'y a pas de bug a ma connaissance, mais je ne les ai pas vraiment cherché non plus.

Si quelqu'un connais une méthode (API) permettant de copier une image(DC) sur une autre (DC) EN LA REDIMENSIONNANT, qu'il me le dise, cela permettrait de faire évoluer la "MiniVue"

tout commentaire est le bienvenu.

Codes Sources

A voir également

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.