[VB6] Zoom su PictureBox e degrado delle prestazioni di disegno

[814(k m49!(]

Ciao,
Ho vari pset, line ecc in una picturebox, ora per fare uno zoom, ridisegno tutto a ogni cambiamento della dimensione della picuturebox, pero' piu elementi contiene e piu (logicamente) ridisegnare diventa lento.

Esiste un modo per evitare di fare un refresh ogni volta?

Grazie

[814(k m49!(]

up

[LMondi]

Per eseguire la funzione di zoom di un'immagine potresti provare il seguente codice, che con il click del tasto sin del mouse ingrandisce e con quello del tasto dex riduce; prova se può esserti utile come esempio da trasportare nella tua realtà:

Option Explicit
Dim w As Long
Dim h As Long
Dim dblRap As Double
Dim dblMont As Double
'------------------------------
Private Sub Command1_Click()
    
    Call ImageLoader

End Sub
'------------------------------
Private Sub ImageLoader()

' Ricava i valori iniziali dell'immagine:
    w = LoadPicture(App.Path & "\funghi1.bmp").Width
    h = LoadPicture(App.Path & "\funghi1.bmp").Height
' Acquisisce il Rapporto h/W:
    dblRap = h / w


' Imposti i valori iniziali delle ScrollBars:
    HScroll1.Min = w / 10
    HScroll1.Max = w
    VScroll1.Min = h / 10
    VScroll1.Max = h
    
    'Valori delle ScollBars e dell'immagine pari
    'ad 1/10 delle dimensioni reali dell'immagine:
    HScroll1.Value = w / 10
    VScroll1.Value = h / 10

' Caricamento l'immagine iniziale:
    Image1.Picture = LoadPicture(App.Path & "\funghi1.bmp", vbLPCustom, , HScroll1.Value, VScroll1.Value)

End Sub
'------------------------------
Private Sub HScroll1_Change()
    Call RefreshPicture
End Sub
'------------------------------
Private Sub VScroll1_Change()
    Call RefreshPicture
End Sub
'------------------------------
Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
       
        ' Diminuisce la dimensione:
        If Button = vbRightButton Then
            Image1.Width = HScroll1.Value
            dblMont = Val(HScroll1.Value * 0.9)
            If dblMont >= HScroll1.Min Then
                HScroll1.Value = dblMont
                Image1.Height = Val(dblRap * HScroll1.Value)
            End If
            ' Aumenta la dimensione:
            ElseIf Button = vbLeftButton Then
            Image1.Width = HScroll1.Value
            dblMont = Val(HScroll1.Value * 1.1)
            HScroll1.Value = dblMont
            Image1.Height = Val(dblRap * HScroll1.Value)
        End If
        
        ' Sposta le ScrollBar in funzione delle dimensioni dell'immagine:
            ' ScrollBar Orizzontali:
            HScroll1.Top = (Image1.Top + Image1.Height)
            HScroll1.Left = (Image1.Left)
            HScroll1.Width = (Image1.Width)
            ' ScrollBar Verticali:
            VScroll1.Top = (Image1.Top)
            VScroll1.Left = (Image1.Left + Image1.Width)
            VScroll1.Height = Image1.Height
  
End Sub
'------------------------------
Private Sub RefreshPicture()
        
        If HScroll1.Value = 0 Or VScroll1.Value = 0 Then Exit Sub
            
            Image1.Height = VScroll1.Value
            Image1.Width = HScroll1.Value
            
          ' Sposta le ScrollBar in funzione delle dimensioni dell'immagine:
            ' ScrollBar Orizzontali:
            HScroll1.Top = (Image1.Top + Image1.Height)
            HScroll1.Left = (Image1.Left)
            HScroll1.Width = (Image1.Width)
            ' ScrollBar Verticali:
            VScroll1.Top = (Image1.Top)
            VScroll1.Left = (Image1.Left + Image1.Width)
            VScroll1.Height = Image1.Height
            
            ' Visualizza le dimensioni dell'immagine:
            Image1.ToolTipText = Format(HScroll1.Value, "##,##0") & " x " & Format(VScroll1.Value, "##,##0")
End Sub

[chipdb]

Penso che LMondi non abbia capito il senso della domanda... Qui si tratta di linee e cerchi, fondamentali della geometria, non di un'immagine esterna caricata.

Vuoi un consiglio?

Usa le API di windows, sono 100 volte più veloci di Line, Circle e company. Copia queste dichiarazioni in un modulo:

Public Declare Function MoveToEx Lib "gdi32" Alias "MoveToEx" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long

Public Declare Function LineTo Lib "gdi32" Alias "LineTo" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Public Declare Function Rectangle Lib "gdi32" Alias "Rectangle" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Public Declare Function Ellipse Lib "gdi32" Alias "Ellipse" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Public Declare Function SetPixelV Lib "gdi32" Alias "SetPixelV" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

A questo punto usa queste funzioni al posto di quelle predefinite di Visual Basic, dove chiede l'hDC tu gli passi quello della PictureBox... Ad esempio se si chiama "PictureBox1" tu dovrai passare come argomento PictureBox1.hDC...

Per fare una linea è semplice, usi la MoveToEx per posizionarti in un punto, e poi la LineTo per disegnare la linea da quel punto al secondo punto della linea...

La SetPixelV fa quello che normalmente fa la PSet...

Le altre funzioni sono autoesplicative...

Per modificare la larghezza ed il colore della linea usi le solite proprietà della PictureBox...

Poi per il resto fai tu lo zoom come meglio credi. Io così ho realizzato un intero sistema CAD.

Ciao ciao!

[814(k m49!(]

ora provo subito, quello che sto cercando di realizzare e' proprio un CAD, solo che ad esempio per l'ellipse mi ero fatto una routine con tanto di calcoli matematici ora provo quello che hai postato, penso (e spero) che faccia al caso mio.

LMondi, poi guardero' anche quello che hai postato, sara' sempre utile, in altre occasioni forse

grazie delle risposte

[814(k m49!(]

ora provo subito, quello che sto cercando di realizzare e' proprio un CAD, solo che ad esempio per l'ellipse mi ero fatto una routine con tanto di calcoli matematici ora provo quello che hai postato, penso (e spero) che faccia al caso mio.

LMondi, poi guardero' anche quello che hai postato, sara' sempre utile, in altre occasioni forse

grazie delle risposte

[814(k m49!(]

ora provo subito, quello che sto cercando di realizzare e' proprio un CAD, solo che ad esempio per l'ellipse mi ero fatto una routine con tanto di calcoli matematici ora provo quello che hai postato, penso (e spero) che faccia al caso mio.

LMondi, poi guardero' anche quello che hai postato, sara' sempre utile, in altre occasioni forse

grazie delle risposte