Скролл картинки

[Fencer]

У меня такая проблема: я загрузил в PictureBox картинку функцией BitBlt, но Пикчур остаётся такого же размера, какой я задал, а картинка больше его (хотя Autosize стоит true). Как можно привязать к Пикчуру scrollbars, или сделать так: жмешь на картинку, удерживая кнопку мыши, и, перемещая курсор, тащишь им картинку (внутри pictureBox'a) Надеюсь, я понятно изложил проблему
Заранее Большое Спасибо.

[Ennor]

Autosize будет работать, только если ты туда картинку загрузишь VB-шными методами самого пикчура, а именно LoadPicture(). Иначе, перед тем как блиттить, предварительно меняй размер пикчура, чтобы все влезло.

А вообще, странный ты: у тебя в подписи - ответ на все вопросы...

[Fencer]

Всё-таки хотелось бы узнать, как можно сделать скролл картинки. К примеру, если в PictureBox'е картинка, выходящая за его пределы, то нажав и удерживая кнопку мыши, можно скроллировать картинку перетаскиванием. Сразу скажу - искал Гуглом и по форуму, пытался сделать сам, но - не выходит...

[tyomitch]

Чесслово, сам на этот форум уже не раз кидал этот код... И GSerg кидал... И мы ещё спорили, чей лучше
"Ищите, да обрящете" (с)

[Fencer]

Чесслово, сам на этот форум уже не раз кидал этот код... И GSerg кидал... И мы ещё спорили, чей лучше

Когда я искал по форуму, не нашёл ничего стоящего. А когда ввёл в поле "Автор" GSerg, а в поле "Что искать" picture, нашёл ваш спор почти сразу же... Мистика, однако

[Fencer]

боюсь, мы не совсем поняли друг друга
Вы писали способы, как таскать сам PictureBox, а мне надо, чтобы Picture был неподвижен, но картинка внутри него таскалась мышой... Это в том случае, если она (картинка, а не мышь ) выходит за пределы Пикчура.[/i]

[tyomitch]

Ок. Picture1 - видимый (в нём скроллинг), Picture2 - невидимый (в нём картинка целиком).

Код: Выделить всё

Option Explicit
Dim sx As Single, sy As Single
Dim dx As Single, dy As Single

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (Button And vbLeftButton) Then dx = X - sx: dy = Y - sy
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (Button And vbLeftButton) Then sx = X - dx: sy = Y - dy: Picture1.Refresh
End Sub

Private Sub Picture1_Paint()
    Picture1.PaintPicture Picture2, sx, sy
End Sub


[Sur]

Я понимаю, что для новичков, но такое.....

Код: Выделить всё

Option Explicit
Private Const SRCCOPY = &HCC0020
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 CurX As Single
Private CurY As Single
Private OffsetX As Single
Private OffsetY As Single
Private xmin As Single
Private ymin As Single
Private Dragging As Boolean

Private Sub Form_Load()
'Picture1 - пустая рамка, Picture2 - наша картинка
Me.ScaleMode = vbPixels: Picture1.ScaleMode = vbPixels: Picture2.ScaleMode = vbPixels
Picture1.AutoRedraw = True: Picture1.AutoSize = False
Picture2.AutoRedraw = True: Picture2.AutoSize = False
xmin = Picture1.Width - Picture2.Width
ymin = Picture1.Height - Picture2.Height
CurX = 0
CurY = 0
DrawPicture
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dragging = True
OffsetX = CurX - x
OffsetY = CurY - y
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Not Dragging Then Exit Sub
If Picture2.Width > Picture1.Width Then CurX = x + OffsetX
If Picture2.Height > Picture1.Height Then CurY = y + OffsetY
If CurX > 0 Then CurX = 0
If CurY > 0 Then CurY = 0
If CurX < xmin Then If xmin < 0 Then CurX = xmin
If CurY < ymin Then If ymin < 0 Then CurY = ymin
DrawPicture
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dragging = False
End Sub

Private Sub DrawPicture()
BitBlt Picture1.hDC, CurX, CurY, Picture2.Width, Picture2.Height, Picture2.hDC, 0, 0, SRCCOPY
Picture1.Refresh
End Sub


[tyomitch]

Я понимаю, что для новичков, но такое.....

Код: Выделить всё

...


Ну и в чём улучшения, кроме замены PaintPicture на BitBlt?

[Sur]

Дергается очень.

[tyomitch]

Дергается очень.

Хорошенькое улучшение

[Al Khamid]

[Sur]

tyomitch
ну твой пример у меня дергается. Может свойство какое я не выставил?

[Fencer]

Я понимаю, что для новичков, но такое.....

Да ладно тебе... Я, например, не знал о том, что есть такой зверь - PaintPicture. Да-да, не знал . Вот теперь знаю . В конце концов, все же были когда-то "чайниками"

[Fencer]

Большое Спасибо вам, люди. Всё работает как надо, и Sur'овский код, и Тёмыча.