1 #Region "Microsoft.VisualBasic::3283f0685afd4e3116d16fec1a0667a5, 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, (+2 Overloads) Clone, ColorBrush, CreateCanvas2D, (+2 Overloads) CreateGDIDevice
37     '                   CreateGrayBitmap, EntireImage, GDIPlusDeviceHandleFromImageFile, GetBrush, GetBrushes
38     '                   (+2 OverloadsGetIcon, GetRawStream, GetStringPath, (+2 Overloads) GraphicsPath, ImageAddFrame
39     '                   IsValidGDIParameter, (+2 Overloads) LoadImage, OpenDevice, (+2 Overloads) PointF, SaveIcon
40     '                   SizeF, ToFloat, ToPoint, ToPoints
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 As StringOptional base64 As Boolean = FalseAs Image
317             If base64 Then
318                 Dim base64String = path.ReadAllText
319                 Dim img As Image = base64String.GetImage
320                 Return img
321             Else
322                 Return FileIO.FileSystem _
323                     .ReadAllBytes(path) _
324                     .LoadImage
325             End If
326         End Function
327
328         <MethodImpl(MethodImplOptions.AggressiveInlining)>
329         <ExportAPI("LoadImage")>
330         <Extension> Public Function LoadImage(rawStream As Byte()) As Image
331             Return Image.FromStream(stream:=New MemoryStream(rawStream))
332         End Function
333
334         ''' <summary>
335         ''' 将图片对象转换为原始的字节流
336         ''' </summary>
337         ''' <param name="image"></param>
338         ''' <returns></returns>
339         '''
340         <ExportAPI("Get.RawStream")>
341         <Extension> Public Function GetRawStream(image As Image) As Byte()
342             Using stream As New MemoryStream
343                 Call image.Save(stream, ImageFormat.Png)
344                 Return stream.ToArray
345             End Using
346         End Function
347
348         <ExportAPI("GrayBitmap"Info:="Create the gray color of the target image.")>
349         <Extension> Public Function CreateGrayBitmap(res As Image) As Image
350             Using g As Graphics2D = DirectCast(res.Clone, Image).CreateCanvas2D
351                 With g
352                     Call ControlPaint.DrawImageDisabled(.Graphics, res, 0, 0, Color.FromArgb(0, 0, 0, 0))
353                     Return .ImageResource
354                 End With
355             End Using
356         End Function
357
358         ''' <summary>
359         ''' Adding a frame box to the target image source.(为图像添加边框)
360         ''' </summary>
361         ''' <param name="canvas"></param>
362         ''' <param name="pen">Default pen width is 1px and with color <see cref="Color.Black"/>.(默认的绘图笔为黑色的1个像素的边框)</param>
363         ''' <returns></returns>
364         ''' <remarks></remarks>
365         <Extension> Public Function ImageAddFrame(canvas As Graphics2D, Optional pen As Pen = NothingOptional offset% = 0) As Graphics2D
366             Dim TopLeft As New Point(offset, offset)
367             Dim TopRight As New Point(canvas.Width - offset, 1 + offset)
368             Dim BtmLeft As New Point(offset + 1, canvas.Height - offset)
369             Dim BtmRight As New Point(canvas.Width - offset, canvas.Height - offset)
370
371             If pen Is Nothing Then
372                 pen = Pens.Black
373             End If
374
375             Call canvas.DrawLine(pen, TopLeft, TopRight)
376             Call canvas.DrawLine(pen, TopRight, BtmRight)
377             Call canvas.DrawLine(pen, BtmRight, BtmLeft)
378             Call canvas.DrawLine(pen, BtmLeft, TopLeft)
379
380             Dim color As New SolidBrush(pen.Color)
381             Dim region As New Rectangle With {
382                 .Size = New Size(1, 1)
383             }
384
385             Call canvas.FillRectangle(color, region)
386
387             Return canvas
388         End Function
389
390         ''' <summary>
391         ''' 创建一个GDI+的绘图设备
392         ''' </summary>
393         ''' <param name="r"></param>
394         ''' <param name="filled">默认的背景填充颜色为白色</param>
395         ''' <returns></returns>
396         ''' <remarks></remarks>
397         <MethodImpl(MethodImplOptions.AggressiveInlining)>
398         <ExportAPI("GDI+.Create")>
399         <Extension> Public Function CreateGDIDevice(r As SizeF, Optional filled As Color = NothingAs Graphics2D
400             Return (New Size(CInt(r.Width), CInt(r.Height))).CreateGDIDevice(filled)
401         End Function
402
403         <Extension> Public Function OpenDevice(ctrl As Control) As Graphics2D
404             Dim img As Image = New Bitmap(ctrl.Width, ctrl.Height)
405             Dim canvas = img.CreateCanvas2D
406
407             If ctrl.BackgroundImage Is Nothing Then
408                 Call canvas.FillRectangle(Brushes.White, New Rectangle(New Point, img.Size))
409             End If
410
411             Return canvas
412         End Function
413
414         ''' <summary>
415         ''' 从指定的文件之中加载GDI+设备的句柄
416         ''' </summary>
417         ''' <param name="path"></param>
418         ''' <returns></returns>
419         '''
420         <ExportAPI("GDI+.Create")>
421         <Extension> Public Function GDIPlusDeviceHandleFromImageFile(path As StringAs Graphics2D
422             Dim image As Image = LoadImage(path)
423             Dim g As Graphics = Graphics.FromImage(image)
424
425             With g
426                 .CompositingQuality = CompositingQuality.HighQuality
427                 .TextRenderingHint = TextRenderingHint.ClearTypeGridFit
428             End With
429
430             Return Graphics2D.CreateObject(g, image)
431         End Function
432
433         ''' <summary>
434         ''' 无需处理图像数据,这个函数默认已经自动克隆了该对象,不会影响到原来的对象,
435         ''' 除非你将<paramref name="directAccess"/>参数设置为真,函数才不会自动克隆图像对象
436         ''' </summary>
437         ''' <param name="res"></param>
438         ''' <returns></returns>
439         <ExportAPI("GDI+.Create")>
440         <Extension> Public Function CreateCanvas2D(res As Image,
441                                                    Optional directAccess As Boolean = False,
442                                 <CallerMemberName> Optional caller$ = ""As Graphics2D
443
444             If directAccess Then
445                 Return Graphics2D.CreateObject(Graphics.FromImage(res), res)
446             Else
447                 With res.Size.CreateGDIDevice
448                     Call .DrawImage(res, 0, 0, .Width, .Height)
449                     Return .ByRef
450                 End With
451             End If
452         End Function
453
454         <Extension> Public Function BackgroundGraphics(ctrl As Control) As Graphics2D
455             If Not ctrl.BackgroundImage Is Nothing Then
456                 Try
457                     Return ctrl.BackgroundImage.CreateCanvas2D
458                 Catch ex As Exception
459                     Call App.LogException(ex)
460                     Return ctrl.Size.CreateGDIDevice(ctrl.BackColor)
461                 End Try
462             Else
463                 Return ctrl.Size.CreateGDIDevice(ctrl.BackColor)
464             End If
465         End Function
466
467         <MethodImpl(MethodImplOptions.AggressiveInlining)>
468         <Extension> Public Function IsValidGDIParameter(size As Size) As Boolean
469             Return size.Width > 0 AndAlso size.Height > 0
470         End Function
471
472         Const InvalidSize As String = "One of the size parameter for the gdi+ device is not valid!"
473
474         ''' <summary>
475         ''' 创建一个GDI+的绘图设备,默认的背景填充色为白色
476         ''' </summary>
477         ''' <param name="r"></param>
478         ''' <param name="filled">默认的背景填充颜色为白色</param>
479         ''' <returns></returns>
480         ''' <remarks></remarks>
481         '''
482         <ExportAPI("GDI+.Create")>
483         <Extension> Public Function CreateGDIDevice(r As Size, Optional filled As Color = Nothing, <CallerMemberName> Optional trace$ = ""Optional dpi$ = "100,100"As Graphics2D
484             Dim bitmap As Bitmap
485
486             If r.Width = 0 OrElse r.Height = 0 Then
487                 Throw New Exception(InvalidSize)
488             End If
489
490             Try
491                 bitmap = New Bitmap(r.Width, r.Height)
492
493                 With dpi.SizeParser
494                     Call bitmap.SetResolution(.Width, .Height)
495                 End With
496             Catch ex As Exception
497                 ex = New Exception(r.ToString, ex)
498                 ex = New Exception(trace, ex)
499                 Call App.LogException(ex, MethodBase.GetCurrentMethod.GetFullName)
500                 Throw ex
501             End Try
502
503             Dim g As Graphics = Graphics.FromImage(bitmap)
504             Dim rect As New Rectangle(New Point, bitmap.Size)
505
506             If filled.IsNullOrEmpty Then
507                 filled = Color.White
508             End If
509
510             Call g.Clear(filled)
511
512             g.InterpolationMode = InterpolationMode.HighQualityBicubic
513             g.PixelOffsetMode = PixelOffsetMode.HighQuality
514             g.CompositingQuality = CompositingQuality.HighQuality
515             g.SmoothingMode = SmoothingMode.HighQuality
516
517             Return Graphics2D.CreateObject(g, bitmap)
518         End Function
519
520         <Extension> Public Function Clone(res As Bitmap) As Bitmap
521             If res Is Nothing Then Return Nothing
522             Return DirectCast(res.Clone, Bitmap)
523         End Function
524
525         <Extension> Public Function Clone(res As Image) As Image
526             If res Is Nothing Then Return Nothing
527             Return DirectCast(res.Clone, Image)
528         End Function
529     End Module
530 End Namespace