Okay, nu er jeg jo ikke så vild med den der BitBlt, men her er mit rod.
Hvis du blot klikker på picture2 vil billedet komme frem. Hvis du så rykker det ganske lidt mod højre, så vil billedet ændre sig meget. Det er ligesomom at den accelererer afstanden ???
Anyway, du har sikkert fået et svar fra tdaugaard over mail, men kan du så ikke lige smide koden her? :-)
-------- CUT ----------
Dim IX As Integer, IY As Integer, TX As Integer
Dim TY As Integer, FX As Integer, FY As Integer
\' ***************IMPORTANT NOTE***************
\'ALL IN A FORM, ALSO HAVE TO ADD THE FOLLOWING CONTROLS AND NAME THEM PROPERLY _
IN ORDER FOR APP TO PERFORM CORRECTLY _
Add a CommandButton and name it cmdBrowse _
Add a PictureBox and name it Picture1 _
Add a HScrollBar and name it HScroll1 _
Add a VScrollBar and name it VScroll1 _
Add a CommonDialog and name it CommonDialog1 (under _
Project/Components/Microsoft Common Dialog Control)
\'*********************************************
Option Explicit
Private Declare Function BitBlt Lib \"gdi32\" (ByVal hDestDC 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 dwRop As Long) As Long
Private Declare Function CreateCompatibleDC Lib \"gdi32\" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib \"gdi32\" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib \"gdi32\" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib \"gdi32\" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib \"gdi32\" (ByVal hdc As Long) As Long
Private Const SRCCOPY = &HCC0020
Private lngDC As Long
Private lngOrigBMP As Long
\'Code:
Private Sub cmdBrowse_Click()
Dim iPic As IPictureDisp
Dim lPrevBMP As Long
Dim iPicWPix As Integer, iPicHPix As Integer
Dim iPicBoxWPix As Integer, iPicBoxHPix As Integer
\'setup common dialog to show only Image files
CommonDialog1.Filter = \"Image Files (*.bmp;*.jpg;*.jpeg;*.gif)|*.BMP;*.JPG;*.JPEG;*.GIF\"
CommonDialog1.ShowOpen
If Not CommonDialog1.FileName = \"\" Then
\'Load the picture to be displayed
Set iPic = LoadPicture(CommonDialog1.FileName)
\'retrieve the pixel coordinates of the Picture to be displayed
iPicWPix = Int(Me.ScaleX(iPic.Width, vbHimetric, vbPixels))
iPicHPix = Int(Me.ScaleY(iPic.Height, vbHimetric, vbPixels))
\'retrieve the pixel coordinates of the PictureBox where the Picture will be displayed
iPicBoxWPix = Int(Me.ScaleX(Picture1.Width, vbTwips, vbPixels))
iPicBoxHPix = Int(Me.ScaleY(Picture1.Height, vbTwips, vbPixels))
If iPicWPix > iPicBoxWPix Then \'if the picture is larger than the picturebox
HScroll1.Enabled = True
HScroll1.Min = 0
\'set the max value of the hscroll bar to the difference between the picture\'s width and the picturebox\'s width
HScroll1.Max = iPicWPix - iPicBoxWPix
Else
HScroll1.Enabled = False
End If
If iPicHPix > iPicBoxHPix Then
VScroll1.Enabled = True
VScroll1.Min = 0
\'set the max value of the vscroll bar to the difference between the picture\'s height and the picturebox\'s height
VScroll1.Max = Int(Me.ScaleY(iPic.Height, vbHimetric, vbPixels)) - Int(Me.ScaleY(Picture1.Height, vbTwips, vbPixels))
Else
VScroll1.Enabled = False
End If
\' select our picture into the Device Context and retrieve the handle _
of the last bitmap selected into the Device Context
lPrevBMP = SelectObject(lngDC, iPic)
Set iPic = Nothing
\'remove the previous bitmap from memory
DeleteObject lPrevBMP
\' display the picture in the picture box
BitBlt Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, lngDC, 0, 0, SRCCOPY
\' show the picture
Picture1.Refresh
End If
End Sub
Private Sub Form_Load()
Dim lBMP As Long
\' assure\'s the picture will not be erased when picturebox is repainted
Picture1.AutoRedraw = True
VScroll1.Enabled = False
HScroll1.Enabled = False
\' get a Device Context to be used for BLTing
lngDC = CreateCompatibleDC(Me.hdc)
\' create a generic bitmap so we can retrieve the handle of the original bitmap created _
with the Device Context (we need the handle later to assure that all objects are removed from memory
lBMP = CreateCompatibleBitmap(lngDC, 1, 1)
\'retrieve the handle of the bitmap orignally created with the Device Context
lngOrigBMP = SelectObject(lngDC, lBMP)
End Sub
Private Sub Form_Unload(Cancel As Integer)
\'free memory used
CleanUp
End Sub
Private Sub HScroll1_Change()
\'display the picture based on the scroll bar value
BitBlt Picture1.hdc, 0 - HScroll1.Value, 0 - VScroll1.Value, Picture1.ScaleWidth, Picture1.ScaleHeight, lngDC, 0, 0, SRCCOPY
\' show the picture
Picture1.Refresh
End Sub
Private Sub HScroll1_Scroll()
\'display the picture based on the scroll bar value
BitBlt Picture1.hdc, 0 - HScroll1.Value, 0 - VScroll1.Value, Picture1.ScaleWidth, Picture1.ScaleHeight, lngDC, 0, 0, SRCCOPY
\' show the picture
Picture1.Refresh
End Sub
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
\'Button = 1 (Venstre Mussetast)
\'Button = 2 (Højer Mussetast)
\'Button = 4 (Midt Mussetast)
If Button = 1 Then
Picture2.Cls
IX = X: IY = Y
FX = Picture2.Left: FY = Picture2.Top
Picture2.Refresh
End If
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Picture2.Move FX + (X - IX), FY + (Y - IY)
FX = Picture2.Left: FY = Picture2.Top
\'Dim retval As Long
\'retval = BitBlt(Picture2.hdc, 10, 10, 1305, 1305, Picture1.hdc, X, Y, &HCC0020)
\'Picture2.Refresh
End If
End Sub
Private Sub Picture2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim nyx, nyy As Integer
Dim retval As Long
If Button = 1 Then
nyy = VScroll1.Value + Picture2.Top
nyx = HScroll1.Value + Picture2.Left
retval = BitBlt(Picture2.hdc, 1, 1, Picture2.ScaleWidth, Picture2.ScaleHeight, Picture1.hdc, nyx, nyy, SRCCOPY)
Text1.Text = retval
End If
\'Picture2.Picture = BitBlt(Picture2.hdc, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, Picture1.hdc, Picture2.ScaleLeft, Picture2.ScaleTop, SRCCOPY)
End Sub
Private Sub VScroll1_Change()
\'display the picture based on the scroll bar value
BitBlt Picture1.hdc, 0 - HScroll1.Value, 0 - VScroll1.Value, Picture1.ScaleWidth, Picture1.ScaleHeight, lngDC, 0, 0, SRCCOPY
\' show the picture
Picture1.Refresh
End Sub
Private Sub VScroll1_Scroll()
\'display the picture based on the scroll bar value
BitBlt Picture1.hdc, 0 - HScroll1.Value, 0 - VScroll1.Value, Picture1.ScaleWidth, Picture1.ScaleHeight, lngDC, 0, 0, SRCCOPY
\'show the picture
Picture1.Refresh
End Sub
Private Sub CleanUp()
Dim lPrevBMP As Long
\'put the original bitmap back into the Device and retrieve the handle of the previous bitmap
lPrevBMP = SelectObject(lngDC, lngOrigBMP)
\'remove the previous bitmap from memory
DeleteObject lPrevBMP
\'free the DC (and all objects created with it) from memory
DeleteDC lngDC
End Sub
Ny bruger
Nybegynder
Opret
Preview
