..::cherche Fonction ZooM::..

Question

salut a toi qui lit ce message 

j'explique mon petit probleme:

je cherche un fonction pour zoomer la courbe que mon prog dessine dans une picture box.

la courbeque je trace est parfois minuscule, donc je souhaiterais qu'avec ma souris je clique sur la picture box,j' etire un rectangle comme lorsque l'on selections des fichier sur son pc
et hop! magie!
la courbe est agrandie
 comment faire?

please help j'en chie depuis des jours!

merci a +

boursicotteur · Answer

J'ai écrit ce petit code pour toi. Il n'est pas parfait mais il fait ce que tu veux. Reste plus qu'à l'adapter à ton appli et à le fignoler.

'btnReset= bouton pour remettre mon image dans pbxImage
'pbxImage= PictureBox

Dim X1, Y1, X2, Y2

Private Sub btnReset_Click()
    pbxImage.Picture = LoadPicture(CurDir & "/Piscine.bmp")
End Sub

Private Sub pbxImage_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    pbxImage.DrawStyle = 2   'Ligne fait de points
    X1 = X
    Y1 = Y
End Sub

Private Sub pbxImage_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        X2 = X
        Y2 = Y
        pbxImage.Cls
        pbxImage.Line (X1, Y1)-(X2, Y2), vbWhite, B 
    End If
End Sub

Private Sub pbxImage_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Wsource = X2 - X1
    Hsource = Y2 - Y1
    Wdest = pbxImage.Width
    Hdest = (Wdest / Wsource) * Hsource
    pbxImage.PaintPicture pbxImage.Picture, 0, 0, Wdest, Hdest, X1, Y1, Wsource, Hsource
End Sub

bdlj39 · Answer

merci pour ta fonction .
mais elle ne marche que si j'ai un image dans ma picture box, et ce n'est pas le cas.

a l'interieur de ma pictur box je trace une ligne avec la methode picture1.line= (x,y)-(x1,y1)

 :)

boursicotteur · Answer

Ya rien d'impossible...
Suffit de faire quelques changements mineurs...
Maintenant ca marche pour les deux (images et dessins)

Il y a:
   1 bouton pour charger une image.
   1 bouton pour dessiner un dessin.

Dim X1, Y1, X2, Y2

Private Sub btnImage_Click()
    'Charge une image
    pbxImage.AutoSize = True
    pbxImage.Picture = LoadPicture(CurDir & "/Piscine.bmp")
End Sub

Private Sub btnDessin_Click()
    'Efface l'image (S'il y en a une)
    pbxImage.Picture = LoadPicture()
    
    'Dessine graph quelconque
    pbxImage.DrawStyle = 0      'Ligne pleine
    pbxImage.AutoRedraw = True  'Ce dessin AutoRedraw ne s'effacera pas avec pbxImage.Refresh
    
    
    
    '########## Tracé d'un graph en utilisant les coor polaires P(vR,vDeg)
    '           (Ici je me suis amusé un peu...)
    
    'Détermine le point d'origine du graph
    Cx0 = 0.5 * pbxImage.Width
    Cy0 = 0.5 * pbxImage.Height
    
    For vDeg = 0 To 1070 Step 1 'Variable vDeg
        'VB fonctionne en Radians alors faut convertir
        Rad = vDeg * (3.1416 / 180)
        
        'Valeur de la Var vR (Chaque équation donne un Graph différent)
        'vR = Rad * 100                         'Graph #1
        'vR = Cx0 / 2 * Sin(7 * Rad)            'Graph #2
        vR = Rad * 100 + Cx0 / 2 * Sin(7 * Rad) 'Graph #3
        
        'Conversion de la coor polaire en coor cartésienne P(vR,vDeg) => C(Cx,Cy)        Cx vR * Cos(Rad) 'où Rad vDeg * (3.1416 / 180)
        Cy = vR * Sin(Rad)

        'Détermine CurrentX et CurrentY pour le 1er point C(x,y) à tracer
        If vDeg = 0 Then
            pbxImage.CurrentX = Cx0 + Cx
            pbxImage.CurrentY = Cy0 + Cy
        End If
        
        'Tracé d'une ligne entre le nouveau point et le point courant
        pbxImage.Line -(Cx0 + Cx, Cy0 + Cy), vbBlue
    Next
    '##########
End Sub

Private Sub pbxImage_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    X1 = X
    Y1 = Y
End Sub

Private Sub pbxImage_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        X2 = X
        Y2 = Y
        
        'Dessine rectangle "Sélection"
        pbxImage.DrawStyle = 2      'Ligne de points
        pbxImage.AutoRedraw = False 'Ce dessin non AutoRedraw s'effacera avec pbxImage.Refresh)
        pbxImage.Refresh            'Efface rectangles "Sélection" précédents
        
        pbxImage.Line (X1, Y1)-(X2, Y2), vbWhite, B
    End If
End Sub

Private Sub pbxImage_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Wsource = X2 - X1
    Hsource = Y2 - Y1
    Wdest = pbxImage.Width
    Hdest = (Wdest / Wsource) * Hsource
   
    pbxImage.PaintPicture pbxImage.Image, 0, 0, Wdest, Hdest, X1, Y1, Wsource, Hsource
End Sub