Как в графическом компоненте контролировать положение картинки? - VB

Узнай цену своей работы

Формулировка задачи:

Это либо PictureBox, либо Image, не так важно. Как в компоненте контролировать положение картинки? Именно загруженной картинки, а не самого компонента.

Решение задачи: «Как в графическом компоненте контролировать положение картинки?»

textual
Листинг программы
  1. Option Explicit
  2.  
  3. Private Type XFORM
  4.     eM11 As Single
  5.     eM12 As Single
  6.     eM21 As Single
  7.     eM22 As Single
  8.     eDx As Single
  9.     eDy As Single
  10. End Type
  11.  
  12. Private Declare Function SetGraphicsMode Lib "gdi32" (ByVal hdc As Long, ByVal iMode As Long) As Long
  13. Private Declare Function SetWorldTransform Lib "gdi32" (ByVal hdc As Long, lpXform As XFORM) As Long
  14. Private Declare Function ModifyWorldTransform Lib "gdi32" (ByVal hdc As Long, lpXform As XFORM, ByVal iMode As Long) As Long
  15.  
  16. Private Const MWT_IDENTITY = 1
  17. Private Const MWT_LEFTMULTIPLY = 2
  18. Private Const MWT_RIGHTMULTIPLY = 3
  19.  
  20. Private Const GM_ADVANCED = 2
  21. Private Const GM_COMPATIBLE = 1
  22.  
  23. Dim Value As Single
  24.  
  25. Private Sub Form_Load()
  26.     SetGraphicsMode picDisp.hdc, GM_ADVANCED
  27. End Sub
  28. Private Sub picDisp_Paint()
  29.     Update
  30. End Sub
  31.  
  32. Private Sub hsbScroll_Change(): picDisp.Refresh: End Sub
  33. Private Sub hsbScroll_Scroll(): picDisp.Refresh: End Sub
  34.  
  35. Private Sub picKnob_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  36.     Static oy As Single
  37.     If Button = vbLeftButton Then
  38.         Value = Value + Y - oy
  39.         If Value < 0 Then Value = 0 Else If Value > 6.28 Then Value = 6.28
  40.         picDisp.Refresh
  41.     End If
  42.     oy = Y
  43. End Sub
  44.  
  45. Private Sub vsbScroll_Change(): picDisp.Refresh: End Sub
  46. Private Sub vsbScroll_Scroll(): picDisp.Refresh: End Sub
  47. Private Sub hsbShear_Change(): picDisp.Refresh: End Sub
  48. Private Sub hsbShear_Scroll(): picDisp.Refresh: End Sub
  49. Private Sub vsbShear_Change(): picDisp.Refresh: End Sub
  50. Private Sub vsbShear_Scroll(): picDisp.Refresh: End Sub
  51. Private Sub hsbScale_Change(): picDisp.Refresh: End Sub
  52. Private Sub hsbScale_Scroll(): picDisp.Refresh: End Sub
  53. Private Sub vsbScale_Change(): picDisp.Refresh: End Sub
  54. Private Sub vsbScale_Scroll(): picDisp.Refresh: End Sub
  55.  
  56. Private Sub Update()
  57.     Dim Mtx1 As XFORM, Mtx2 As XFORM, Mtx3 As XFORM, v As Single, c As Single, s As Single
  58.    
  59.     picKnob.Cls
  60.     v = Value * 0.75
  61.     picKnob.Circle (0, 0), 0.9, vbButtonShadow, 5.498, 3.927
  62.     If v > 0 Then picKnob.Circle (0, 0), 0.8, vbButtonText, -IIf(v > 3.927, 10.21 - v, 3.927 - v), -3.927
  63.    
  64.     Mtx1.eDx = -hsbScroll.Value
  65.     Mtx1.eDy = -vsbScroll.Value
  66.     Mtx1.eM11 = hsbScale.Value / 100
  67.     Mtx1.eM22 = vsbScale.Value / 100
  68.     Mtx1.eM12 = hsbShear.Value / 100
  69.     Mtx1.eM21 = vsbShear.Value / 100
  70.  
  71.     c = Cos(Value): s = Sin(Value)
  72.     Mtx2.eM11 = c: Mtx2.eM12 = s: Mtx2.eM21 = -s: Mtx2.eM22 = c
  73.     Mtx2.eDx = picDisp.ScaleWidth / 2: Mtx2.eDy = picDisp.ScaleHeight / 2
  74.    
  75.     Mtx3.eM11 = 1: Mtx3.eM22 = 1
  76.     Mtx3.eDx = -picDisp.ScaleWidth / 2
  77.     Mtx3.eDy = -picDisp.ScaleHeight / 2
  78.    
  79.     ModifyWorldTransform picDisp.hdc, Mtx1, MWT_IDENTITY
  80.     picDisp.Line (0, 0)-(picDisp.ScaleWidth, picDisp.ScaleHeight), picDisp.BackColor, BF
  81.    
  82.    
  83.     ModifyWorldTransform picDisp.hdc, Mtx3, MWT_RIGHTMULTIPLY
  84.     ModifyWorldTransform picDisp.hdc, Mtx2, MWT_RIGHTMULTIPLY
  85.     ModifyWorldTransform picDisp.hdc, Mtx1, MWT_RIGHTMULTIPLY
  86. End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

5   голосов , оценка 3.6 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы