ICEE/FastDrawing.cls at master · greatbody/ICEE · 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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "FastDrawing"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'
Option Explicit
'Í¼ÏñÆØ¹âÂÊ
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbAlpha As Byte
End Type
Private Type BITMAPINFOHEADER
        bmSize As Long
        bmWidth As Long
        bmHeight As Long
        bmPlanes As Integer
        bmBitCount As Integer
        bmCompression As Long
        bmSizeImage As Long
        bmXPelsPerMeter As Long
        bmYPelsPerMeter As Long
        bmClrUsed As Long
        bmClrImportant As Long
End Type
Private Type BITMAPINFO
        bmHeader As BITMAPINFOHEADER
        bmColors(0 To 255) As RGBQUAD
End Type
Private Declare Function GetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function StretchDIBits Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal dX As Long, ByVal dY As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal SrcWidth As Long, ByVal SrcHeight As Long, lpBits As Any, lpBitsInfo As BITMAPINFO, ByVal wUsage As Long, ByVal dwRop As Long) As Long

Public Function GetImageWidth(SrcPictureBox As PictureBox) As Long
    Dim bm As BITMAP
    GetObject SrcPictureBox.image, Len(bm), bm
    GetImageWidth = bm.bmWidth
End Function
Public Function GetImageHeight(SrcPictureBox As PictureBox) As Long
    Dim bm As BITMAP
    GetObject SrcPictureBox.image, Len(bm), bm
    GetImageHeight = bm.bmHeight
End Function
Public Function GetImageStreamLength(SrcPictureBox As PictureBox) As Long
    Dim bm As BITMAP
    GetObject SrcPictureBox.image, Len(bm), bm
    GetImageStreamLength = (bm.bmWidth * (bm.bmHeight + 1)) * 3
End Function
Public Sub GetImageData2D(SrcPictureBox As PictureBox, ImageData() As Byte)
    Dim bm As BITMAP
    GetObject SrcPictureBox.image, Len(bm), bm
    Erase ImageData()
    Dim ArrayWidth As Long
    ArrayWidth = (bm.bmWidth * 3) - 1
    ArrayWidth = ArrayWidth + (bm.bmWidth Mod 4)
    ReDim ImageData(0 To ArrayWidth, 0 To bm.bmHeight) As Byte
    Dim bmi As BITMAPINFO
    bmi.bmHeader.bmWidth = bm.bmWidth
    bmi.bmHeader.bmHeight = bm.bmHeight
    bmi.bmHeader.bmSize = 40
    bmi.bmHeader.bmPlanes = 1
    bmi.bmHeader.bmBitCount = 24
    bmi.bmHeader.bmCompression = 0
    GetDIBits SrcPictureBox.hdc, SrcPictureBox.image, 0, bm.bmHeight, ImageData(0, 0), bmi, 0

End Sub

Public Sub SetImageData2D(DstPictureBox As PictureBox, OriginalWidth As Long, OriginalHeight As Long, ImageData() As Byte)
    Dim bm As BITMAP
    GetObject DstPictureBox.image, Len(bm), bm
    Dim bmi As BITMAPINFO
    bmi.bmHeader.bmWidth = OriginalWidth
    bmi.bmHeader.bmHeight = OriginalHeight
    bmi.bmHeader.bmSize = 40
    bmi.bmHeader.bmPlanes = 1
    bmi.bmHeader.bmBitCount = 24
    bmi.bmHeader.bmCompression = 0
    StretchDIBits DstPictureBox.hdc, 0, 0, bm.bmWidth, bm.bmHeight, 0, 0, OriginalWidth, OriginalHeight, ImageData(0, 0), bmi, 0, vbSrcCopy
    If DstPictureBox.AutoRedraw = True Then
        DstPictureBox.Picture = DstPictureBox.image
        DstPictureBox.Refresh
    End If
    DoEvents
End Sub
Public Sub GetImageData(SrcPictureBox As PictureBox, ImageData() As Byte)
    Dim bm As BITMAP
    GetObject SrcPictureBox.image, Len(bm), bm
    Erase ImageData()
    ReDim ImageData(0 To 2, 0 To bm.bmWidth - 1, 0 To bm.bmHeight - 1)
    Dim bmi As BITMAPINFO
    bmi.bmHeader.bmWidth = bm.bmWidth
    bmi.bmHeader.bmHeight = bm.bmHeight
    bmi.bmHeader.bmSize = 40
    bmi.bmHeader.bmPlanes = 1
    bmi.bmHeader.bmBitCount = 24
    bmi.bmHeader.bmCompression = 0
    GetDIBits SrcPictureBox.hdc, SrcPictureBox.image, 0, bm.bmHeight, ImageData(0, 0, 0), bmi, 0
End Sub
Public Sub SetImageData(DstPictureBox As PictureBox, OriginalWidth As Long, OriginalHeight As Long, ImageData() As Byte)
    Dim bm As BITMAP
    GetObject DstPictureBox.image, Len(bm), bm
    Dim bmi As BITMAPINFO
    bmi.bmHeader.bmWidth = OriginalWidth
    bmi.bmHeader.bmHeight = OriginalHeight
    bmi.bmHeader.bmSize = 40
    bmi.bmHeader.bmPlanes = 1
    bmi.bmHeader.bmBitCount = 24
    bmi.bmHeader.bmCompression = 0
    StretchDIBits DstPictureBox.hdc, 0, 0, bm.bmWidth, bm.bmHeight, 0, 0, OriginalWidth, OriginalHeight, ImageData(0, 0, 0), bmi, 0, vbSrcCopy
    If DstPictureBox.AutoRedraw = True Then
        DstPictureBox.Picture = DstPictureBox.image
        DstPictureBox.Refresh
    End If
    DoEvents
End Sub

Public Sub GetImageDataStream(SrcPictureBox As PictureBox, ImageData() As Byte)
    Dim bm As BITMAP
    GetObject SrcPictureBox.image, Len(bm), bm
    Erase ImageData()
    ReDim ImageData(0 To GetImageStreamLength(SrcPictureBox))
    Dim bmi As BITMAPINFO
    bmi.bmHeader.bmWidth = bm.bmWidth
    bmi.bmHeader.bmHeight = bm.bmHeight
    bmi.bmHeader.bmSize = 40
    bmi.bmHeader.bmPlanes = 1
    bmi.bmHeader.bmBitCount = 24
    bmi.bmHeader.bmCompression = 0
    GetDIBits SrcPictureBox.hdc, SrcPictureBox.image, 0, bm.bmHeight, ImageData(0), bmi, 0
End Sub

Public Sub SetImageDataStream(DstPictureBox As PictureBox, OriginalWidth As Long, OriginalHeight As Long, ImageData() As Byte)
    Dim bm As BITMAP
    GetObject DstPictureBox.image, Len(bm), bm
    Dim bmi As BITMAPINFO
    bmi.bmHeader.bmWidth = OriginalWidth
    bmi.bmHeader.bmHeight = OriginalHeight
    bmi.bmHeader.bmSize = 40
    bmi.bmHeader.bmPlanes = 1
    bmi.bmHeader.bmBitCount = 24
    bmi.bmHeader.bmCompression = 0
    StretchDIBits DstPictureBox.hdc, 0, 0, bm.bmWidth, bm.bmHeight, 0, 0, OriginalWidth, OriginalHeight, ImageData(0), bmi, 0, vbSrcCopy
    If DstPictureBox.AutoRedraw = True Then
        DstPictureBox.Picture = DstPictureBox.image
        DstPictureBox.Refresh
    End If
    DoEvents
End Sub