ViPad/GraphicCheckBox.ctl at master · lee-soft/ViPad · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
VERSION 5.00
Begin VB.UserControl GraphicCheckBox
   AutoRedraw      =   -1  'True
   BackColor       =   &H00000000&
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   3600
   ScaleWidth      =   4800
End
Attribute VB_Name = "GraphicCheckBox"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private m_graphics As GDIPGraphics
Private m_graphicsImage As GDIPGraphics
Private m_currentBitmap As GDIPBitmap

Private m_thisImage As GDIPImage
Private m_tickedCheckBox As GDIPImage
Private m_value As Boolean

Public Event onChange()

Public Property Get Value() As Boolean
    Value = m_value
End Property

Public Property Let Value(newValue As Boolean)
    If Not m_value = newValue Then
        m_value = newValue
        DrawSomething

        RaiseEvent onChange
    End If
End Property

Private Function DrawSomething()
    If UserControl.BackColor = vbBlack Then
        m_graphicsImage.Clear
    Else
        m_graphicsImage.Clear UserControl.BackColor
    End If

    If m_value Then
        m_graphicsImage.DrawImage m_tickedCheckBox, 0, 0, m_tickedCheckBox.Width, m_tickedCheckBox.Height
    Else
        m_graphicsImage.DrawImage m_thisImage, 0, 0, m_thisImage.Width, m_thisImage.Height
    End If

    RefreshHDC
End Function

Function DrawImageStretchRect(ByRef Image As GDIPImage, ByRef destRect As RECTL, ByRef sourceRect As RECTL)
    m_graphicsImage.DrawImageStretchAttrF Image, _
        RECTLtoF(destRect), _
        sourceRect.Left, sourceRect.Top, sourceRect.Width, sourceRect.Height, UnitPixel, 0, 0, 0
End Function

Private Function InitializeGraphics()
    Set m_graphics = New GDIPGraphics
    m_graphics.FromHDC UserControl.hdc

    m_graphics.SmoothingMode = SmoothingModeHighQuality
    m_graphics.InterpolationMode = InterpolationModeHighQualityBicubic
End Function

Private Sub UserControl_Initialize()
    InitializeGDIIfNotInitialized

    Set m_graphics = New GDIPGraphics
    Set m_graphicsImage = New GDIPGraphics
    Set m_currentBitmap = New GDIPBitmap

    Set m_thisImage = New GDIPImage
    Set m_tickedCheckBox = New GDIPImage

    m_thisImage.FromBinary LoadResData("EMPTY_CHECKBOX", "IMAGE")
    m_tickedCheckBox.FromBinary LoadResData("TICKED_CHECKBOX", "IMAGE")

    InitializeGraphics
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    m_value = Not m_value
    DrawSomething

    RaiseEvent onChange
End Sub

Private Sub UserControl_Resize()
    If InIDE Then Exit Sub

    m_currentBitmap.CreateFromSizeFormat UserControl.ScaleWidth, UserControl.ScaleHeight, PixelFormat.Format32bppArgb
    m_graphicsImage.FromImage m_currentBitmap.Image

    InitializeGraphics
    DrawSomething

    UserControl.Width = m_tickedCheckBox.Width * Screen.TwipsPerPixelX
    UserControl.Height = m_tickedCheckBox.Height * Screen.TwipsPerPixelY
End Sub

Private Sub RefreshHDC()
    On Error GoTo Handler
    If m_graphics Is Nothing Then Exit Sub

    If UserControl.BackColor = vbBlack Then
        m_graphics.Clear
    Else
        m_graphics.Clear UserControl.BackColor
    End If

    m_graphics.DrawImage m_currentBitmap.Image, 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight
Handler:
    UserControl.Refresh
End Sub


'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
    BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    UserControl.BackColor() = New_BackColor
    PropertyChanged "BackColor"

    UserControl_Resize
End Property

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    UserControl.BackColor = PropBag.ReadProperty("BackColor", &HFF&)
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &HFF&)
End Sub