1	#Region "Microsoft.VisualBasic::ceab6e114bde434d5109c60edf574226, Microsoft.VisualBasic.Core\Extensions\Image\GDI+\GraphicsExtensions.vb"
2
3	' Author:
4	'
5	'       asuka (amethyst.asuka@gcmodeller.org)
6	'       xie (genetics@smrucc.org)
7	'       xieguigang (xie.guigang@live.com)
8	'
9	' Copyright (c) 2018 GPL3 Licensed
10	'
11	'
12	' GNU GENERAL PUBLIC LICENSE (GPL3)
13	'
14	'
15	' This program is free software: you can redistribute it and/or modify
16	' it under the terms of the GNU General Public License as published by
17	' the Free Software Foundation, either version 3 of the License, or
18	' (at your option) any later version.
19	'
20	' This program is distributed in the hope that it will be useful,
21	' but WITHOUT ANY WARRANTY; without even the implied warranty of
22	' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23	' GNU General Public License for more details.
24	'
25	' You should have received a copy of the GNU General Public License
26	' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30	' /********************************************************************************/
31
32	' Summaries:
33
34	'     Module GraphicsExtensions
35	'
36	'         Function: BackgroundGraphics, CanvasCreateFromImageFile, (+2 Overloads) Clone, ColorBrush, CreateCanvas2D
37	'                   (+3 Overloads) CreateGDIDevice, CreateGrayBitmap, EntireImage, GetBrush, GetBrushes
38	'                   (+2 Overloads) GetIcon, GetStreamBuffer, GetStringPath, (+2 Overloads) GraphicsPath, ImageAddFrame
39	'                   IsValidGDIParameter, (+2 Overloads) LoadImage, OpenDevice, (+2 Overloads) PointF, SaveIcon
40	'                   SizeF, ToFloat, ToPoint, ToPoints, ToStream
41	'
42	'         Sub: (+5 Overloads) DrawCircle
43	'
44	'
45	' /********************************************************************************/
46
47	#End Region
48
49	Imports System.Drawing
50	Imports System.Drawing.Drawing2D
51	Imports System.Drawing.Imaging
52	Imports System.Drawing.Text
53	Imports System.IO
54	Imports System.Reflection
55	Imports System.Runtime.CompilerServices
56	Imports Microsoft.VisualBasic.CommandLine.Reflection
57	Imports Microsoft.VisualBasic.ComponentModel.Algorithm.base
58	Imports Microsoft.VisualBasic.Language
59	Imports Microsoft.VisualBasic.Linq
60	Imports Microsoft.VisualBasic.Net.Http
61	Imports Microsoft.VisualBasic.Scripting.MetaData
62	Imports Microsoft.VisualBasic.Scripting.Runtime
63
64	Namespace Imaging
65
66	''' <summary>
67	''' GDI+
68	''' </summary>
69	'''
70	<Package("GDI+", Description:="GDI+ GDIPlus Extensions Module to provide some useful interface.",
71	Publisher:="xie.guigang@gmail.com",
72	Revision:=58,
73	Url:="http://gcmodeller.org")>
74	Public Module GraphicsExtensions
75
76	<Extension>
77	Public Function GetStringPath(s$, dpi!, rect As RectangleF, font As Font, format As StringFormat) As GraphicsPath
78	Dim path As New GraphicsPath()
79	' Convert font size into appropriate coordinates
80	Dim emSize! = dpi * font.SizeInPoints / 72
81	path.AddString(s, font.FontFamily, font.Style, emSize, rect, format)
82	Return path
83	End Function
84
85	<MethodImpl(MethodImplOptions.AggressiveInlining)>
86	<Extension> Public Function PointF(polygon As IEnumerable(Of Point)) As IEnumerable(Of PointF)
87	Return polygon.Select(Function(pt) New PointF(pt.X, pt.Y))
88	End Function
89
90	<MethodImpl(MethodImplOptions.AggressiveInlining)>
91	<Extension>
92	Public Function SizeF(size As Size) As SizeF
93	Return New SizeF(size.Width, size.Height)
94	End Function
95
96	<MethodImpl(MethodImplOptions.AggressiveInlining)>
97	<Extension> Public Function ToPoint(pf As PointF) As Point
98	Return New Point(pf.X, pf.Y)
99	End Function
100
101	<MethodImpl(MethodImplOptions.AggressiveInlining)>
102	<Extension> Public Function ToPoints(ps As IEnumerable(Of PointF)) As Point()
103	Return ps.Select(Function(x) New Point(x.X, x.Y)).ToArray
104	End Function
105
106	<Extension> Public Function SaveIcon(ico As Icon, path$) As Boolean
107	Call path.ParentPath.MkDIR
108
109	Try
110	Using file As New FileStream(path, FileMode.OpenOrCreate)
111	Call ico.Save(file)
112	Call file.Flush()
113	End Using
114
115	Return True
116	Catch ex As Exception
117	Call App.LogException(New Exception(path, ex))
118	End Try
119
120	Return False
121	End Function
122
123	<MethodImpl(MethodImplOptions.AggressiveInlining)>
124	<Extension>
125	Public Function ToFloat(rect As Rectangle) As RectangleF
126	Return New RectangleF With {
127	.Location = rect.Location.PointF,
128	.Size = rect.Size.SizeF
129	}
130	End Function
131
132	<MethodImpl(MethodImplOptions.AggressiveInlining)>
133	<Extension>
134	Public Function PointF(pf As Point) As PointF
135	Return New PointF(pf.X, pf.Y)
136	End Function
137
138	<Extension>
139	Public Function GraphicsPath(points As IEnumerable(Of Point)) As GraphicsPath
140	Dim path As New GraphicsPath
141
142	For Each pt In points.SlideWindows(2)
143	Call path.AddLine(pt(0), pt(1))
144	Next
145
146	Return path
147	End Function
148
149	<Extension>
150	Public Function GraphicsPath(points As IEnumerable(Of PointF)) As GraphicsPath
151	Dim path As New GraphicsPath
152
153	For Each pt In points.SlideWindows(2)
154	Call path.AddLine(pt(0), pt(1))
155	Next
156
157	Return path
158	End Function
159
160	''' <summary>
161	''' 同时兼容颜色以及图片纹理画刷的创建
162	''' </summary>
163	''' <param name="res$"></param>
164	''' <returns></returns>
165	<Extension> Public Function GetBrush(res$) As Brush
166	Dim bgColor As Color = res.TranslateColor
167
168	If Not bgColor.IsEmpty Then
169	Return New SolidBrush(bgColor)
170	Else
171	Dim img As Image
172
173	If res.FileExists Then
174	img = LoadImage(path:=res$)
175	Else
176	img = Base64Codec.GetImage(res$)
177	End If
178
179	Return New TextureBrush(img)
180	End If
181	End Function
182
183	<MethodImpl(MethodImplOptions.AggressiveInlining)>
184	<Extension>
185	Public Function ColorBrush(c As Color) As SolidBrush
186	Return New SolidBrush(color:=c)
187	End Function
188
189	''' <summary>
190	''' Converts the colors into solidbrushes in batch.
191	''' </summary>
192	''' <param name="colors"></param>
193	''' <returns></returns>
194	'''
195	<MethodImpl(MethodImplOptions.AggressiveInlining)>
196	<Extension>
197	Public Function GetBrushes(colors As IEnumerable(Of Color)) As SolidBrush()
198	Return colors _
199	.SafeQuery _
200	.Select(Function(c) New SolidBrush(c)) _
201	.ToArray
202	End Function
203
204	<Extension>
205	Public Sub DrawCircle(ByRef g As Graphics, centra As PointF, r!, color As SolidBrush)
206	Dim d = r * 2
207
208	With centra
209	Call g.FillPie(color, .X - r, .Y - r, d, d, 0, 360)
210	End With
211	End Sub
212
213	<Extension>
214	Public Sub DrawCircle(ByRef g As Graphics, centra As PointF, r!, color As Pen, Optional fill As Boolean = True)
215	With centra
216	Dim d! = r * 2
217	Dim rect As New Rectangle(.X - r, .Y - r, d, d)
218
219	If fill Then
220	Call g.FillPie(New SolidBrush(color.Color), rect, 0, 360)
221	Else
222	Call g.DrawEllipse(color, rect)
223	End If
224	End With
225	End Sub
226
227	''' <summary>
228	''' 模仿Java之中的``DrawCircle``方法
229	''' </summary>
230	''' <param name="g"></param>
231	''' <param name="color"></param>
232	''' <param name="x!"></param>
233	''' <param name="y!"></param>
234	''' <param name="r!"></param>
235	''' <param name="fill"></param>
236	'''
237	<MethodImpl(MethodImplOptions.AggressiveInlining)>
238	<Extension>
239	Public Sub DrawCircle(ByRef g As Graphics, color As Pen, x!, y!, r!, Optional fill As Boolean = True)
240	Call g.DrawCircle(New PointF(x, y), r, color, fill)
241	End Sub
242
243	<Extension>
244	Public Sub DrawCircle(ByRef g As IGraphics, centra As PointF, r!, color As Brush)
245	Dim d = r * 2
246
247	With centra
248	Call g.FillPie(color, .X - r, .Y - r, d, d, 0, 360)
249	End With
250	End Sub
251
252	''' <summary>
253	''' 进行圆的绘制
254	''' </summary>
255	''' <param name="g"></param>
256	''' <param name="centra">圆心的坐标，这个函数之中会自动转换为<see cref="Rectangle"/>的左上角位置坐标</param>
257	''' <param name="r!">圆的半径</param>
258	''' <param name="color">线条的颜色</param>
259	''' <param name="fill">是否进行填充？</param>
260	<Extension>
261	Public Sub DrawCircle(ByRef g As IGraphics, centra As PointF, r!, color As Pen, Optional fill As Boolean = True)
262	Dim d = r * 2
263
264	With centra
265	If fill Then
266	Call g.FillPie(New SolidBrush(color.Color), .X - r, .Y - r, d, d, 0, 360)
267	Else
268	Call g.DrawEllipse(color, .X - r, .Y - r, d, d)
269	End If
270	End With
271	End Sub
272
273	''' <summary>
274	''' 返回整个图像的区域
275	''' </summary>
276	''' <param name="img"></param>
277	''' <returns></returns>
278	<Extension>
279	Public Function EntireImage(img As Image) As Rectangle
280	Dim size As Size = img.Size
281	Return New Rectangle(New Point, size)
282	End Function
283
284	''' <summary>
285	''' Convert image to icon
286	''' </summary>
287	''' <param name="res"></param>
288	''' <returns></returns>
289	'''
290	<MethodImpl(MethodImplOptions.AggressiveInlining)>
291	<ExportAPI("To.Icon")>
292	<Extension> Public Function GetIcon(res As Image) As Icon
293	Return Icon.FromHandle(New Bitmap(res).GetHicon)
294	End Function
295
296	''' <summary>
297	''' Convert image to icon
298	''' </summary>
299	''' <param name="res"></param>
300	''' <returns></returns>
301	'''
302	<MethodImpl(MethodImplOptions.AggressiveInlining)>
303	<ExportAPI("To.Icon")>
304	<Extension> Public Function GetIcon(res As Bitmap) As Icon
305	Return Icon.FromHandle(res.GetHicon)
306	End Function
307
308	''' <summary>
309	''' Load image from a file and then close the file handle.
310	''' (使用<see cref="Image.FromFile(String)"/>函数在加载完成图像到Dispose这段之间内都不会释放文件句柄，
311	''' 则使用这个函数则没有这个问题，在图片加载之后会立即释放掉文件句柄)
312	''' </summary>
313	''' <param name="path"></param>
314	''' <returns></returns>
315	<ExportAPI("LoadImage"), Extension>
316	Public Function LoadImage(path$,
317	Optional base64 As Boolean = False,
318	Optional throwEx As Boolean = True) As Image
319	If base64 Then
320	Dim base64String = path.ReadAllText
321	Dim img As Image = base64String.GetImage
322	Return img
323	Else
324	Try
325	Return FileIO.FileSystem _
326	.ReadAllBytes(path) _
327	.LoadImage
328	Catch ex As Exception
329	If throwEx Then
330	Throw New Exception(path, ex)
331	Else
332	Call App.LogException(New Exception(path, ex))
333	Return Nothing
334	End If
335	End Try
336	End If
337	End Function
338
339	<MethodImpl(MethodImplOptions.AggressiveInlining)>
340	<ExportAPI("LoadImage")>
341	<Extension> Public Function LoadImage(rawStream As Byte()) As Image
342	Return Image.FromStream(stream:=New MemoryStream(rawStream))
343	End Function
344
345	''' <summary>
346	''' 将图片对象转换为原始的字节流
347	''' </summary>
348	''' <param name="image"></param>
349	''' <returns></returns>
350	<MethodImpl(MethodImplOptions.AggressiveInlining)>
351	<ExportAPI("Get.RawStream")>
352	<Extension> Public Function GetStreamBuffer(image As Image) As Byte()
353	Return image.ToStream.ToArray
354	End Function
355
356	Public Function ToStream(image As Image) As MemoryStream
357	With New MemoryStream
358	Call image.Save(.ByRef, ImageFormat.Png)
359	Return .ByRef
360	End With
361	End Function
362
363	<ExportAPI("GrayBitmap", Info:="Create the gray color of the target image.")>
364	<Extension> Public Function CreateGrayBitmap(res As Image) As Image
365	Using g As Graphics2D = DirectCast(res.Clone, Image).CreateCanvas2D
366	With g
367	Call ControlPaint.DrawImageDisabled(.Graphics, res, 0, 0, Color.FromArgb(0, 0, 0, 0))
368	Return .ImageResource
369	End With
370	End Using
371	End Function
372
373	''' <summary>
374	''' Adding a frame box to the target image source.(为图像添加边框)
375	''' </summary>
376	''' <param name="canvas"></param>
377	''' <param name="pen">Default pen width is 1px and with color <see cref="Color.Black"/>.(默认的绘图笔为黑色的1个像素的边框)</param>
378	''' <returns></returns>
379	''' <remarks></remarks>
380	<Extension> Public Function ImageAddFrame(canvas As Graphics2D, Optional pen As Pen = Nothing, Optional offset% = 0) As Graphics2D
381	Dim TopLeft As New Point(offset, offset)
382	Dim TopRight As New Point(canvas.Width - offset, 1 + offset)
383	Dim BtmLeft As New Point(offset + 1, canvas.Height - offset)
384	Dim BtmRight As New Point(canvas.Width - offset, canvas.Height - offset)
385
386	If pen Is Nothing Then
387	pen = Pens.Black
388	End If
389
390	Call canvas.DrawLine(pen, TopLeft, TopRight)
391	Call canvas.DrawLine(pen, TopRight, BtmRight)
392	Call canvas.DrawLine(pen, BtmRight, BtmLeft)
393	Call canvas.DrawLine(pen, BtmLeft, TopLeft)
394
395	Dim color As New SolidBrush(pen.Color)
396	Dim region As New Rectangle With {
397	.Size = New Size(1, 1)
398	}
399
400	Call canvas.FillRectangle(color, region)
401
402	Return canvas
403	End Function
404
405	''' <summary>
406	''' 创建一个GDI+的绘图设备
407	''' </summary>
408	''' <param name="r"></param>
409	''' <param name="filled">默认的背景填充颜色为白色</param>
410	''' <returns></returns>
411	''' <remarks></remarks>
412	<MethodImpl(MethodImplOptions.AggressiveInlining)>
413	<ExportAPI("GDI+.Create")>
414	<Extension> Public Function CreateGDIDevice(r As SizeF, Optional filled As Color = Nothing) As Graphics2D
415	Return (New Size(CInt(r.Width), CInt(r.Height))).CreateGDIDevice(filled)
416	End Function
417
418	<Extension> Public Function OpenDevice(ctrl As Control) As Graphics2D
419	Dim img As Image = New Bitmap(ctrl.Width, ctrl.Height)
420	Dim canvas = img.CreateCanvas2D
421
422	If ctrl.BackgroundImage Is Nothing Then
423	Call canvas.FillRectangle(Brushes.White, New Rectangle(New Point, img.Size))
424	End If
425
426	Return canvas
427	End Function
428
429	''' <summary>
430	''' 从指定的文件之中加载GDI+设备的句柄
431	''' </summary>
432	''' <param name="path"></param>
433	''' <returns></returns>
434	'''
435	<ExportAPI("GDI+.Create")>
436	<Extension> Public Function CanvasCreateFromImageFile(path As String) As Graphics2D
437	Dim image As Image = LoadImage(path)
438	Dim g As Graphics = Graphics.FromImage(image)
439
440	With g
441	.CompositingQuality = CompositingQuality.HighQuality
442	.TextRenderingHint = TextRenderingHint.ClearTypeGridFit
443	End With
444
445	Return Graphics2D.CreateObject(g, image)
446	End Function
447
448	''' <summary>
449	''' 无需处理图像数据，这个函数默认已经自动克隆了该对象，不会影响到原来的对象，
450	''' 除非你将<paramref name="directAccess"/>参数设置为真，函数才不会自动克隆图像对象
451	''' </summary>
452	''' <param name="res"></param>
453	''' <returns></returns>
454	<ExportAPI("GDI+.Create")>
455	<Extension> Public Function CreateCanvas2D(res As Image,
456	Optional directAccess As Boolean = False,
457	<CallerMemberName> Optional caller$ = "") As Graphics2D
458
459	If directAccess Then
460	Return Graphics2D.CreateObject(Graphics.FromImage(res), res)
461	Else
462	With res.Size.CreateGDIDevice
463	Call .DrawImage(res, 0, 0, .Width, .Height)
464	Return .ByRef
465	End With
466	End If
467	End Function
468
469	<Extension> Public Function BackgroundGraphics(ctrl As Control) As Graphics2D
470	If Not ctrl.BackgroundImage Is Nothing Then
471	Try
472	Return ctrl.BackgroundImage.CreateCanvas2D
473	Catch ex As Exception
474	Call App.LogException(ex)
475	Return ctrl.Size.CreateGDIDevice(ctrl.BackColor)
476	End Try
477	Else
478	Return ctrl.Size.CreateGDIDevice(ctrl.BackColor)
479	End If
480	End Function
481
482	<MethodImpl(MethodImplOptions.AggressiveInlining)>
483	<Extension> Public Function IsValidGDIParameter(size As Size) As Boolean
484	Return size.Width > 0 AndAlso size.Height > 0
485	End Function
486
487	Const InvalidSize As String = "One of the size parameter for the gdi+ device is not valid!"
488
489	''' <summary>
490	''' 创建一个GDI+的绘图设备，默认的背景填充色为白色
491	''' </summary>
492	''' <param name="r"></param>
493	''' <param name="filled">默认的背景填充颜色为白色</param>
494	''' <returns></returns>
495	''' <remarks></remarks>
496	<MethodImpl(MethodImplOptions.AggressiveInlining)>
497	<ExportAPI("GDI+.Create")>
498	<Extension> Public Function CreateGDIDevice(r As Size,
499	Optional filled$ = NameOf(Color.White),
500	<CallerMemberName>
501	Optional trace$ = "",
502	Optional dpi$ = "100,100") As Graphics2D
503	Return r.CreateGDIDevice(filled.TranslateColor, trace, dpi)
504	End Function
505
506	''' <summary>
507	''' 创建一个GDI+的绘图设备，默认的背景填充色为白色
508	''' </summary>
509	''' <param name="r"></param>
510	''' <param name="filled">默认的背景填充颜色为白色</param>
511	''' <returns></returns>
512	''' <remarks></remarks>
513	'''
514	<ExportAPI("GDI+.Create")>
515	<Extension> Public Function CreateGDIDevice(r As Size, filled As Color,
516	<CallerMemberName>
517	Optional trace$ = "",
518	Optional dpi$ = "100,100") As Graphics2D
519	Dim bitmap As Bitmap
520
521	If r.Width = 0 OrElse r.Height = 0 Then
522	Throw New Exception(InvalidSize)
523	End If
524
525	Try
526	bitmap = New Bitmap(r.Width, r.Height)
527
528	With dpi.SizeParser
529	Call bitmap.SetResolution(.Width, .Height)
530	End With
531	Catch ex As Exception
532	ex = New Exception(r.ToString, ex)
533	ex = New Exception(trace, ex)
534	Call App.LogException(ex, MethodBase.GetCurrentMethod.GetFullName)
535	Throw ex
536	End Try
537
538	Dim g As Graphics = Graphics.FromImage(bitmap)
539	Dim rect As New Rectangle(New Point, bitmap.Size)
540
541	If filled.IsNullOrEmpty Then
542	filled = Color.White
543	End If
544
545	Call g.Clear(filled)
546
547	g.InterpolationMode = InterpolationMode.HighQualityBicubic
548	g.PixelOffsetMode = PixelOffsetMode.HighQuality
549	g.CompositingQuality = CompositingQuality.HighQuality
550	g.SmoothingMode = SmoothingMode.HighQuality
551
552	Return Graphics2D.CreateObject(g, bitmap)
553	End Function
554
555	<Extension> Public Function Clone(res As Bitmap) As Bitmap
556	If res Is Nothing Then Return Nothing
557	Return DirectCast(res.Clone, Bitmap)
558	End Function
559
560	<Extension> Public Function Clone(res As Image) As Image
561	If res Is Nothing Then Return Nothing
562	Return DirectCast(res.Clone, Image)
563	End Function
564	End Module
565	End Namespace