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

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

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

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

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

textual
Листинг программы
Option Explicit
 
Private Type XFORM
    eM11 As Single
    eM12 As Single
    eM21 As Single
    eM22 As Single
    eDx As Single
    eDy As Single
End Type
 
Private Declare Function SetGraphicsMode Lib "gdi32" (ByVal hdc As Long, ByVal iMode As Long) As Long
Private Declare Function SetWorldTransform Lib "gdi32" (ByVal hdc As Long, lpXform As XFORM) As Long
Private Declare Function ModifyWorldTransform Lib "gdi32" (ByVal hdc As Long, lpXform As XFORM, ByVal iMode As Long) As Long
 
Private Const MWT_IDENTITY = 1
Private Const MWT_LEFTMULTIPLY = 2
Private Const MWT_RIGHTMULTIPLY = 3
 
Private Const GM_ADVANCED = 2
Private Const GM_COMPATIBLE = 1
 
Dim Value As Single
 
Private Sub Form_Load()
    SetGraphicsMode picDisp.hdc, GM_ADVANCED
End Sub
Private Sub picDisp_Paint()
    Update
End Sub
 
Private Sub hsbScroll_Change(): picDisp.Refresh: End Sub
Private Sub hsbScroll_Scroll(): picDisp.Refresh: End Sub
 
Private Sub picKnob_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Static oy As Single
    If Button = vbLeftButton Then
        Value = Value + Y - oy
        If Value < 0 Then Value = 0 Else If Value > 6.28 Then Value = 6.28
        picDisp.Refresh
    End If
    oy = Y
End Sub
 
Private Sub vsbScroll_Change(): picDisp.Refresh: End Sub
Private Sub vsbScroll_Scroll(): picDisp.Refresh: End Sub
Private Sub hsbShear_Change(): picDisp.Refresh: End Sub
Private Sub hsbShear_Scroll(): picDisp.Refresh: End Sub
Private Sub vsbShear_Change(): picDisp.Refresh: End Sub
Private Sub vsbShear_Scroll(): picDisp.Refresh: End Sub
Private Sub hsbScale_Change(): picDisp.Refresh: End Sub
Private Sub hsbScale_Scroll(): picDisp.Refresh: End Sub
Private Sub vsbScale_Change(): picDisp.Refresh: End Sub
Private Sub vsbScale_Scroll(): picDisp.Refresh: End Sub
 
Private Sub Update()
    Dim Mtx1 As XFORM, Mtx2 As XFORM, Mtx3 As XFORM, v As Single, c As Single, s As Single
    
    picKnob.Cls
    v = Value * 0.75
    picKnob.Circle (0, 0), 0.9, vbButtonShadow, 5.498, 3.927
    If v > 0 Then picKnob.Circle (0, 0), 0.8, vbButtonText, -IIf(v > 3.927, 10.21 - v, 3.927 - v), -3.927
    
    Mtx1.eDx = -hsbScroll.Value
    Mtx1.eDy = -vsbScroll.Value
    Mtx1.eM11 = hsbScale.Value / 100
    Mtx1.eM22 = vsbScale.Value / 100
    Mtx1.eM12 = hsbShear.Value / 100
    Mtx1.eM21 = vsbShear.Value / 100
 
    c = Cos(Value): s = Sin(Value)
    Mtx2.eM11 = c: Mtx2.eM12 = s: Mtx2.eM21 = -s: Mtx2.eM22 = c
    Mtx2.eDx = picDisp.ScaleWidth / 2: Mtx2.eDy = picDisp.ScaleHeight / 2
    
    Mtx3.eM11 = 1: Mtx3.eM22 = 1
    Mtx3.eDx = -picDisp.ScaleWidth / 2
    Mtx3.eDy = -picDisp.ScaleHeight / 2
    
    ModifyWorldTransform picDisp.hdc, Mtx1, MWT_IDENTITY
    picDisp.Line (0, 0)-(picDisp.ScaleWidth, picDisp.ScaleHeight), picDisp.BackColor, BF
    
    
    ModifyWorldTransform picDisp.hdc, Mtx3, MWT_RIGHTMULTIPLY
    ModifyWorldTransform picDisp.hdc, Mtx2, MWT_RIGHTMULTIPLY
    ModifyWorldTransform picDisp.hdc, Mtx1, MWT_RIGHTMULTIPLY
End Sub

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


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

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

5   голосов , оценка 3.6 из 5
Похожие ответы