Newsgroup: it.comp.lang.visual-basic
Titolo: [Zoom su img]mi potete correggere il cod.,pf?

Come da soggetto,sto "scrivendo" un piccolo prg per visualizzare e
zommare immagini con annessa visualizzazione di un punto ricercato alle
coordinate x,y.
Sono riuscito a creare uno zoom finestra,lo scroll(ancora da
sistemare)ma ora sono in crisi con alcuni rapporti tra le vrie picture
che "giocano" per fare gli zoom.
Il problema è questo:
Su di un form ho inserito 3 picure (PicSource,PicAll,PicZoom) PicSource
con proprietà AutoSize = True.
PicZoom.Width=710
PicZoom.Heght=657
Carico una bmp da 1000*800 in PicSource.
A questo punto,impostato forzatamente visualizzo un pallino alle
coordinate 500,400 nella picAll (quella che mostra tutta l'immagine),fin
qui tutto bene.
Quando vado a fare lo zoom,vorrei che lo stesso pallino mi comparisse
anche sulla PicZoom,come posso fare ?Mi date una mano?
Grazie a tutti
Vi allego il source:
Option Explicit
Dim X1 As Integer, X2 As Integer, Y1 As Integer, Y2 As Integer, XStart
As Integer, YStart As Integer
Dim ULeftX As Integer, ULeftY As Integer
Private Sub Form_Load()
picAll.PaintPicture picSource, 0, 0, picAll.Width, picAll.Height
picZoom.PaintPicture picSource, 0, 0, picZoom.Width, picZoom.Height, 0,
0, 710, 657
Controls.Add "vb.shape", "shpZoomBox", picAll
HScroll1.Max = (picSource.Width - 710) + 2
VScroll1.Max = (picSource.Height - 657) + 1
'NOTA
'SOSTITUIRE 500 e 400 CON I VALORI TROVATI SUL FILE
Dim Raggio
For Raggio = 0 To 4
    picAll.Circle (Fix(500 / (picSource.Width / picAll.Width)), Fix(400
/ (picSource.Height / picAll.Height))), Raggio, vbBlue
Next Raggio
End Sub
Private Sub picAll_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
XStart = Fix(X * (picSource.Width / picAll.Width))
YStart = Fix(Y * (picSource.Height / picAll.Height))
X1 = X
Y1 = Y
Controls("shpZoomBox").Left = X1
Controls("shpZoomBox").Top = Y1
Controls("shpZoomBox").Width = 0
Controls("shpZoomBox").Height = 0
Controls("shpZoomBox").BorderStyle = 3
Controls("shpZoomBox").Visible = True
End Sub
Private Sub picAll_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
ZoomBoxArea X1, X, Y1, Y
If Controls("shpZoomBox").Visible = True Then
   picAll.MousePointer = vbCustom
   picAll.MouseIcon = imgLente.Picture
   Controls("shpZoomBox").Width = minX(X1, X)
   Controls("shpZoomBox").Height = minY(Y1, Y)
End If
Form1.Caption = Fix(X * (picSource.Width / picAll.Width)) & "-" & Fix(Y
* (picSource.Height / picAll.Height))
End Sub
Public Function minX(X1, X2)
If X1 < X2 Then
   minX = X2 - X1
   Controls("shpZoomBox").Left = X1
Else
   minX = X1 - X2
   Controls("shpZoomBox").Left = X1 - minX
End If
End Function
Public Function minY(Y1, Y2)
If Y1 < Y2 Then
   minY = Y2 - Y1
   Controls("shpZoomBox").Top = Y1
Else
   minY = Y1 - Y2
   Controls("shpZoomBox").Top = Y1 - minY
End If
End Function
Public Sub ZoomBoxArea(X1, X2, Y1, Y2)
 If X1 < X2 And Y1 > Y2 Then
   ULeftX = X1
   ULeftY = Y2
 ElseIf X1 > X2 And Y1 > Y2 Then
   ULeftX = X2
   ULeftY = Y2
ElseIf X1 > X2 And Y1 < Y2 Then
   ULeftX = X2
   ULeftY = Y1
Else
   ULeftX = X1
   ULeftY = Y1
End If
End Sub
Private Sub picAll_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)
Dim XTemp As Integer
Dim YTemp As Integer
Controls("shpZoomBox").Visible = False
picAll.MousePointer = 2
X2 = Fix(X * (picSource.Width / picAll.Width))
Y2 = Fix(Y * (picSource.Height / picAll.Height))
If XStart > X2 Then
    XTemp = XStart
    XStart = X2
    X2 = XTemp
End If
If YStart > Y2 Then
    YTemp = YStart
    YStart = Y2
    Y2 = YTemp
End If
picZoom.Refresh
picZoom.PaintPicture picSource, 0, 0, picZoom.Width, picZoom.Height,
XStart, YStart, (X2 - XStart), (Y2 - YStart)
'A QUESTO PUNTO DOVREI VISUALIZZARE IL PALLINO ALLE COORDINATE
RAPPORTATE ALLO ZOOM !!!!
End Sub
Private Sub picZoom_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
If X2 <> 0 Then
    Form1.Caption = Fix((X / (picZoom.Width / (X2 - XStart)) + XStart))
& "-" & Fix((Y / (picZoom.Height / (Y2 - YStart)) + YStart))
Else
    Form1.Caption = X & "," & Y
End If
End Sub
Private Sub HScroll1_Change()
If HScroll1.Value <= (picSource.Width - 710) + 2 Then
    picZoom.PaintPicture picSource, 0, 0, picZoom.Width, picZoom.Height,
HScroll1.Value, VScroll1.Value, 710, 657
End If
End Sub
Private Sub VScroll1_Change()
If VScroll1.Value <= (picSource.Height - 657) + 1 Then
    picZoom.PaintPicture picSource, 0, 0, picZoom.Width, picZoom.Height,
HScroll1.Value, VScroll1.Value, 710, 657
End If
End Sub
-- 
Posted via Mailgate.ORG Server - 
http://www.Mailgate.ORG

Ho trovato,grazie cmq

 Ho trovato,grazie cmq