VB6+PictureBox+ScrollBars

[udpn]

Надо сделать вроде бы обычную вещь, но срочно. Добавить к пикбоксу два скроллбара(х и в). У меня че-то не получается.
Основные требования такие: min, max, pos, enabled
Если кто знает, как сделать, чтоб при нажатии кнопки End IDE с этим кодом не вылетал, скажите.

[alibek]

udpn, перечитай правила.
Ты явно ошибся разделом.


tag_warning

[alibek]

По сабжу.
Если ты хочешь, чтобы это за тебя кто-то сделал, то на форуме есть раздел "Работа". Пиши туда, предлагай оплату.
Если ты хочешь, чтобы тебе помогли разобраться в проблеме, то напиши, какие усилия были предприняты.

[udpn]

ок, а, я неверно выразился, сорри. помгите разобраться в сабже =)
сейчас в аттач засуну файлег, где я пытался че-то сделать.

зы Рад что так быстро ответили, раньше постил на vbnet.ru, а там одни флудеры и отвечают часа через 4.

[alibek]

Сабклассинг, таймер, зачем это?
Скроллинг картинки делается намного проще.
Есть picPhotoPreview (PictureBox). В нем есть imgPhotoPreview (Image) и два скролл-бара hscPhoto и vscPhoto.
Затем используешь примерно такой код:

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

Private Sub hscPhoto_Change()
If fBusyInterface Then Exit Sub
If fBusyResize Then Exit Sub
imgPhotoPreview.Left = varPhotoOriginX - hscPhoto.Value
End Sub

Private Sub hscPhoto_Scroll()
hscPhoto_Change
End Sub

Private Sub vscPhoto_Change()
If fBusyInterface Then Exit Sub
If fBusyResize Then Exit Sub
imgPhotoPreview.Top = varPhotoOriginY - vscPhoto.Value
End Sub

Private Sub vscPhoto_Scroll()
vscPhoto_Change
End Sub

Private Sub picPhotoPreview_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> vbLeftButton Then Exit Sub
If imgPhotoPreview.Picture Is Nothing Then Exit Sub
varPhotoMoveX = X
varPhotoMoveY = Y
varPhotoMoveLeft = hscPhoto.Value
varPhotoMoveTop = vscPhoto.Value
End Sub

Private Sub picPhotoPreview_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim DX As Long, DY As Long
If Button <> vbLeftButton Then Exit Sub
If imgPhotoPreview.Picture Is Nothing Then Exit Sub
DX = varPhotoMoveLeft - (X - varPhotoMoveX)
If DX < hscPhoto.Min Then DX = hscPhoto.Min
If DX > hscPhoto.Max Then DX = hscPhoto.Max
DY = varPhotoMoveTop - (Y - varPhotoMoveY)
If DY < vscPhoto.Min Then DY = vscPhoto.Min
If DY > vscPhoto.Max Then DY = vscPhoto.Max
fBusyResize = True
If hscPhoto.Enabled Then hscPhoto.Value = DX
If vscPhoto.Enabled Then vscPhoto.Value = DY
imgPhotoPreview.Move varPhotoOriginX - hscPhoto.Value, varPhotoOriginY - vscPhoto.Value
fBusyResize = False
End Sub

Private Sub picPhotoPreview_Resize()
If fBusyResize Then Exit Sub
Dim varRatio As Boolean, varAutofit As Boolean, varScale As Double
Dim W As Long, H As Long, W0 As Long, H0 As Long, R As Double, R0 As Double, V As Long, VM As Long
varPhotoOriginX = 0
varPhotoOriginY = 0
If cmbPhotoScale.ListIndex = 0 Then
  varRatio = (chkPhotoRatio.Value = vbChecked)
  varAutofit = True
  varScale = 0
Else
  varRatio = False
  varAutofit = False
  varScale = 1#
  If cmbPhotoScale.ListIndex > 0 Then varScale = cmbPhotoScale.ItemData(cmbPhotoScale.ListIndex) / 100#
End If
If imgPhotoPreview.Picture Is Nothing Then
  imgPhotoPreview.Visible = False
  imgPhotoPreview.Move picPhotoPreview.ScaleLeft, picPhotoPreview.ScaleTop, picPhotoPreview.ScaleWidth, picPhotoPreview.ScaleHeight
  vscPhoto.Max = 0
  vscPhoto.Enabled = False
  hscPhoto.Max = 0
  hscPhoto.Enabled = False
  Exit Sub
End If
W0 = picPhotoPreview.ScaleX(imgPhotoPreview.Picture.Width, ScaleModeConstants.vbHimetric, ScaleModeConstants.vbPixels)
H0 = picPhotoPreview.ScaleY(imgPhotoPreview.Picture.Height, ScaleModeConstants.vbHimetric, ScaleModeConstants.vbPixels)
If W0 = 0 Or H0 = 0 Then
  imgPhotoPreview.Visible = False
  imgPhotoPreview.Move picPhotoPreview.ScaleLeft, picPhotoPreview.ScaleTop, picPhotoPreview.ScaleWidth, picPhotoPreview.ScaleHeight
  vscPhoto.Max = 0
  vscPhoto.Enabled = False
  hscPhoto.Max = 0
  hscPhoto.Enabled = False
  Exit Sub
End If
R0 = W0 / H0
R = picPhotoPreview.ScaleWidth / picPhotoPreview.ScaleHeight
If varAutofit Then
  If varRatio Then
    If R0 > R Then
      varScale = picPhotoPreview.ScaleWidth / W0
    Else
      varScale = picPhotoPreview.ScaleHeight / H0
    End If
    W = W0 * varScale
    H = H0 * varScale
  Else
    W = picPhotoPreview.ScaleWidth
    H = picPhotoPreview.ScaleHeight
  End If
Else
  W = W0 * varScale
  H = H0 * varScale
End If
fBusyInterface = True
If W > picPhotoPreview.ScaleWidth Then
  V = hscPhoto.Value * varScale
  VM = W - picPhotoPreview.ScaleWidth
  If V > VM Then V = VM
  hscPhoto.Max = VM
  hscPhoto.Value = V
  hscPhoto.LargeChange = picPhotoPreview.ScaleWidth
  hscPhoto.Enabled = True
Else
  hscPhoto.Max = 0
  hscPhoto.Enabled = False
End If
If H > picPhotoPreview.ScaleHeight Then
  V = vscPhoto.Value * varScale
  VM = H - picPhotoPreview.ScaleHeight
  If V > VM Then V = VM
  vscPhoto.Max = VM
  vscPhoto.Value = V
  vscPhoto.LargeChange = picPhotoPreview.ScaleHeight
  vscPhoto.Enabled = True
Else
  vscPhoto.Max = 0
  vscPhoto.Enabled = False
End If
If W < picPhotoPreview.ScaleWidth Then varPhotoOriginX = (picPhotoPreview.ScaleWidth - W) / 2
If H < picPhotoPreview.ScaleHeight Then varPhotoOriginY = (picPhotoPreview.ScaleHeight - H) / 2
imgPhotoPreview.Move varPhotoOriginX - hscPhoto.Value, varPhotoOriginY - vscPhoto.Value, W, H
imgPhotoPreview.Visible = True
fBusyInterface = False
End Sub


[udpn]

В том то и дело, что идет не скроллинг картинки, а редактирование текста. Кроме того, использования стандартных ScrollBar элементов хотелось бы избежать, в первую очередь из-за их уродливости.

[Andrey Fedorov]

Можно посмотреть здесь.

А стандартные скролбары действительно уродство...

[udpn]

MISSING: vbAccelerator VB6 Subclassing and Timer Assistant
Разводить длл ни к чему.

[udpn]

ActiveX Component Can't Create Object даже при подгрузке лишнего файла.

[alibek]

Так ведь на vbAccelerator указано, какие файлы дополнительно нужно скачать.
Внешняя DLL нужна именно для того, чтобы у тебя не падала IDE, когда ты будешь нажимать кнопку End.

[udpn]

Если уж пришлось выбирать, то лучше уж вылет чем лишний мусор. Редактирую код в обход этой длл, чего очень не хотелось. Но мне будет приятно если кто-то его знает

[alibek]

Да не сделаешь ты этого.
Чтобы IDE не падала, надо восстановить предыдущий обработчик сообщений (снять сабклассинг). А это невозможно сделать из кода, потому что при нажатии кнопки End не происходит никаких событий.
Ну разве что попробуй использовать UserControl, который при событии Initialize будет сабклассить родительское окно, а при событии Terminate будет восстанавливать обработчик. Не уверен, что это сработает, но вдруг.

[Andrey Fedorov]

Можешь еще приложенный проектик посмотреть.

[udpn]

Выбранное приложение больше не существует

404 File Not Found: The File api_scroll1994955182006_396.zip does not exist.

[Andrey Fedorov]

Выбранное приложение больше не существует

404 File Not Found: The File api_scroll1994955182006_396.zip does not exist.

Интересно... Впрочем, пример был взят с www.planet-source-code.com.

[udpn]

собсно по дебильному номеру заметил =) я уже переписал акселераторский пример, все пашет ништяк и без долбанутой библы, хоть и вылетает. А для End я приделал Add-on SG Subclasser 0.2 =)

[Andrey Fedorov]

Чтой-то сейчас файл к письму вообще не добавляется - похоже сайт поглючить решил. Потому просто ссылка: http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=65387&lngWId=1

[udpn]

Все нори, все работает. Токо ссылка тож битая =) Скоро отошлю вам sample все равно срок пропустил, так что будет у вас крутой блочный редактор с сорсами =)