diff --git a/Microsoft.VisualBasic.Core/src/Extensions/Image/Bitmap/netcore8.0/Image.vb b/Microsoft.VisualBasic.Core/src/Extensions/Image/Bitmap/netcore8.0/Image.vb index afb8ba678d..08683c4fa1 100644 --- a/Microsoft.VisualBasic.Core/src/Extensions/Image/Bitmap/netcore8.0/Image.vb +++ b/Microsoft.VisualBasic.Core/src/Extensions/Image/Bitmap/netcore8.0/Image.vb @@ -90,6 +90,11 @@ Namespace Imaging Throw New NotImplementedException End Sub + + Public Sub SetPixel(x As Integer, y As Integer, pixel As Color) + Call memoryBuffer.SetPixel(x, y, pixel) + End Sub + Public Function Resize(newWidth As Integer, newHeight As Integer) As Bitmap Dim pixels = memoryBuffer.GetARGB pixels = BitmapResizer.ResizeImage(pixels, memoryBuffer.Width, memoryBuffer.Height, newWidth, newHeight) diff --git a/gr/Microsoft.VisualBasic.Imaging/TextureResourceLoader.vb b/gr/Microsoft.VisualBasic.Imaging/TextureResourceLoader.vb index fd89691ea9..c9755c7139 100644 --- a/gr/Microsoft.VisualBasic.Imaging/TextureResourceLoader.vb +++ b/gr/Microsoft.VisualBasic.Imaging/TextureResourceLoader.vb @@ -52,10 +52,7 @@ #End Region Imports System.Drawing -Imports Microsoft.VisualBasic.CommandLine.Reflection Imports Microsoft.VisualBasic.Imaging.BitmapImage -Imports Microsoft.VisualBasic.Language -Imports Microsoft.VisualBasic.Scripting.MetaData ''' ''' Default texture brush provider @@ -65,39 +62,50 @@ Public Module TextureResourceLoader ''' ''' 按照指定的资源图片和参数进行纹理资源的剪裁处理 ''' - ''' + ''' ''' ''' 纹理模块之间在水平上的间隔宽度 ''' 纹理模块之间在竖直方向上的间隔宽度 ''' ''' ''' - - Public Function LoadTextureResource(Resource As Image, Size As Size, IntervalWidth As Integer, IntervalHeight As Integer) As Image() - Dim list As New List(Of Image) + Public Iterator Function LoadTextureResource(res As Image, Size As Size, IntervalWidth As Integer, IntervalHeight As Integer) As IEnumerable(Of Bitmap) Dim X As Integer Dim Y As Integer + Dim spirit As BitmapBuffer = BitmapBuffer.FromImage(res) Do While True - Dim resToken As Image = Resource.ImageCrop(New Rectangle(New Point(X, Y), Size)) + Dim resToken As New Bitmap(Size.Width, Size.Height) + + ' make copy of a rection in location x,y and rectangle in size + ' from spirit texture resource to resToken bitmap + For xi As Integer = 0 To Size.Width + For yi As Integer = 0 To Size.Height + resToken.SetPixel(xi, yi, spirit.GetPixel(xi + X, yi + Y)) + Next + Next + + Yield resToken - list += resToken X += IntervalWidth + Size.Width - If X >= Resource.Width Then + If X >= res.Width Then X = 0 Y += Size.Height + IntervalHeight End If - If Y >= Resource.Height Then + If Y >= res.Height Then Exit Do End If Loop - - Return list.ToArray End Function - + ''' + ''' adjust of the image color of the texture image + ''' + ''' + ''' + ''' Public Function AdjustColor(Image As Image, Color As Color) As Image Dim res As BitmapBuffer = BitmapBuffer.FromImage(Image) Dim X, Y As Integer @@ -126,8 +134,19 @@ Public Module TextureResourceLoader Return res.GetImage End Function - - Public Function LoadInternalDefaultResource() As Image() - Return TextureResourceLoader.LoadTextureResource(My.Resources.DefaultTexture, New Size(27, 19), 6, 6) + ''' + ''' Load default internal texture image resource + ''' + ''' + Public Function LoadInternalDefaultResource() As Bitmap() + Dim [default] As Bitmap + +#If NET48 Then + [default] = My.Resources.DefaultTexture +#Else + [default] = Bitmap.FromStream(My.Resources.ResourceManager.GetStream("DefaultTexture")) +#End If + + Return TextureResourceLoader.LoadTextureResource([default], New Size(27, 19), 6, 6).ToArray End Function End Module