Newsgroup: it.comp.lang.visual-basic
Titolo: [PictureBox+Zoom]mi correggete il prg,pf?

salve,
premette che questo prg è solo un esercizio che mi piacerebbe portare a
termine.Sono sempre affascinato dal poter utilizzare (in modo limitato)
la grafica con VB.Premesso,il problema è questo:
Vorrei aprire un'immagine e poterla zoommare con il classico tasto dx e
sx,e "scrollarla".Il codice che ho rappezzato,curiosando in rete e
adattandolo +o- è il seguente,ingredienti:
ScaleMode= pixel
1 Form 
1 PictureBox (Picture1) ,Autoredraw=True,Autosize=True
1 PictureBox (picOriginale) ,Autoredraw=False,Autosize=True
1 Slider orizzontale (Slider1),Max 10,Min -8
1 VScrollbar (VScroll1)
1 HScrollbar (HScroll1)
1 CommonDialog (cmmdialog)
1 Bottone + 2 Textbox (1 e 2)
Il problema è questo,è lenta!!!,ho provato a sostituire la Paintpicture
con StretchBlt ma non funge,avete suggerimenti per velocizzare?(userei
jpg da 500k fino a 5-6 Mb)
CODICE........
Option Explicit
Private hdcNew As Long
Private srcewid As Long, srcehgt As Long
Private ZoomVal As Single
'Private Declare Function StretchBlt Lib "gdi32.dll" (ByVal hdc As Long,
ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As
Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long,
ByVal hSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long)
As Long
'Const SRCCOPY = &HCC0020
'Dim retval As Long
Private Sub ReDisplay()
Me.Picture1.Cls
'retval = StretchBlt(Picture1.hDC, -Me.HScroll1.Value,
-Me.VScroll1.Value, srcewid * ZoomVal, srcehgt * ZoomVal,
picOriginale.hDC, , srcewid, srcehgt, SRCCOPY)
Picture1.PaintPicture picOriginale, -Me.HScroll1.Value,
-Me.VScroll1.Value, srcewid * ZoomVal, srcehgt * ZoomVal, 0, 0, srcewid,
srcehgt, vbSrcCopy
Me.Picture1.Refresh
End Sub
Private Sub Command1_Click()
'QUESTO MI SERVE PER EVIDENZIARE UN PUNTO ALLE X E Y RICERCATE
If ZoomVal > 0 Then
    Picture1.Circle ((Text1.Text * ZoomVal) - HScroll1.Value,
-VScroll1.Value + (Text2.Text * ZoomVal)), 10, vbRed
Else
    Picture1.Circle ((Text1.Text - HScroll1.Value) / ZoomVal,
-VScroll1.Value + (Text2.Text / ZoomVal)), 10, vbRed
End If
End Sub
Private Sub Form_Load()
Slider1.Value = Slider1.Value - 5
Call Slider1_Change
End Sub
Private Sub Form_Resize()
Dim lngResult
On Error Resume Next
With Me.Picture1
  .Left = 0
  .Top = 0
  .Width = Me.ScaleWidth - Me.VScroll1.Width
  .Height = Me.ScaleHeight - Me.HScroll1.Height * 3
End With
With Me.HScroll1
  .Top = Me.Picture1.ScaleHeight + 2
  .Left = 0
  .Width = Me.Picture1.ScaleWidth + 2
End With
With Me.VScroll1
  .Top = 0
  .Left = Me.Picture1.ScaleWidth + 2
  .Height = Me.Picture1.ScaleHeight + 2
End With
 
With Me.Slider1
       .Top = Me.ScaleHeight - .Height
       .Left = 0
       .Width = Me.HScroll1.Width
End With
 
Call Slider1_Change
Me.Refresh
HScroll1.Value = 0
VScroll1.Value = 0
End Sub
Private Sub mnuFileExit_Click()
Unload Me
End Sub
Private Sub mnuFileOpen_Click()
Dim FN_Temp$, M$
cmmDialog.DialogTitle = "Carica una nuova mappa"
cmmDialog.Filter = "Immagini (*.bmp)|*.bmp|Immagini
(*.jpeg)|*.jpg|Immagini (*.gif)|*.gif|Immagini (*.wmf)|*.wmf"
cmmDialog.FilterIndex = 2
cmmDialog.ShowOpen
FN_Temp$ = cmmDialog.FileName
picOriginale.Picture = LoadPicture(FN_Temp$)
hdcNew = picOriginale.hDC
srcewid = picOriginale.Width
srcehgt = picOriginale.Height
Call Slider1_Change
 
errCancle:
End Sub
Private Sub mnuViewNormal_Click()
Slider1.Value = 1
Call Slider1_Change
End Sub
Private Sub mnuViewZoomOn_Click()
On Error Resume Next
Slider1.Value = Slider1.Value + 1
Call Slider1_Change
End Sub
Private Sub mnuViewZoomOut_Click()
On Error Resume Next
Slider1.Value = Slider1.Value - 1
Call Slider1_Change
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As
Single, y As Single)
On Error Resume Next
If Button = 1 Then
    Slider1.Value = Slider1.Value + 1
    Call Slider1_Change
Else
    Slider1.Value = Slider1.Value - 1
    Call Slider1_Change
End If
End Sub
Private Sub Slider1_Change()
On Error Resume Next
 
If Slider1.Value < 1 Then
    ZoomVal = Abs(1 / (Slider1.Value - 2))
Else
    ZoomVal = Slider1.Value
End If
If Me.Picture1.ScaleHeight >= srcehgt * ZoomVal Then
  Me.VScroll1.Visible = False
Else
  Me.VScroll1.Visible = True
End If
 If Me.Picture1.ScaleWidth >= srcewid * ZoomVal Then
  Me.HScroll1.Visible = False
Else
  Me.HScroll1.Visible = True
End If
 
With Me.HScroll1
    .Max = Abs(srcewid * ZoomVal - Me.Picture1.ScaleWidth)
    .SmallChange = .Max / 10
    .LargeChange = .Max / 5
    .Value = 0
End With
With Me.VScroll1
    .Max = Abs(srcehgt * ZoomVal - Me.Picture1.ScaleHeight)
    .SmallChange = .Max / 10
    .LargeChange = .Max / 5
    .Value = 0
End With
 
Call ReDisplay
frmPrincipale.StatusBar1.Panels(1) = "Zoom : " & Fix(ZoomVal * 100) & "
%"
End Sub
Private Sub VScroll1_Change()
Call ReDisplay
If ZoomVal > 0 Then
    Picture1.Circle ((Text1.Text * ZoomVal) - HScroll1.Value,
-VScroll1.Value + (Text2.Text * ZoomVal)), 10, vbRed
Else
    Picture1.Circle ((Text1.Text - HScroll1.Value) / ZoomVal,
-VScroll1.Value + (Text2.Text / ZoomVal)), 10, vbRed
End If
End Sub
Private Sub HScroll1_Change()
Call ReDisplay
If ZoomVal > 0 Then
    Picture1.Circle ((Text1.Text * ZoomVal) - HScroll1.Value,
-VScroll1.Value + (Text2.Text * ZoomVal)), 10, vbRed
Else
    Picture1.Circle ((Text1.Text - HScroll1.Value) / ZoomVal,
-VScroll1.Value + (Text2.Text / ZoomVal)), 10, vbRed
End If
End Sub
-- 
Posted via Mailgate.ORG Server - 
http://www.Mailgate.ORG

 adattandolo +o- è il seguente...
Oramai e' talmente facile lavorare in Net con le GDI+, che in vb6 non mi
sognerei nemmeno di rifarlo ^_^
Se sei spinto dallo studio, gia' dovresti essere contento che funzioni imho
^_^
PS: una cosa simile :
http://www.g2kweb.it/gigio2k/modificaimm.asp?file=Modding/uso-pc.jpg&w=&zoom=50
e' realizzata con una 1 riga di codice in GetThumbnailImage.aspx in
http://www.g2kweb.it/public/download/
-- 
-Gigio@Work(?)-