Как в графическом компоненте контролировать положение картинки? - 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д