elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.


Tema destacado: ¿Eres usuario del foro? Ahora tienes un Bot con IA que responde preguntas. Lo puedes activar en tu Perfil


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP) (Moderador: kub0x)
| | | |-+  Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)		0 Usuarios y 1 Visitante están viendo este tema.
Páginas: 1 ... 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 [62] Ir Abajo Respuesta Imprimir
Autor Tema: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)  (Leído 630,657 veces)
Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.981



Ver Perfil
Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
« Respuesta #610 en: 9 Diciembre 2025, 09:16 am »
Un simple TypeConverter junto a un UITypeEditor (opcional) para representar un color en formato web.



Nota: los colores no se ven como deberían por la compresión de imagen del software que he usado para capturar el GIF animado xD

WebColorConverter.vb
Código
  1. #Region " Option Statements "
  2.  
  3. Option Strict On
  4. Option Explicit On
  5. Option Infer Off
  6.  
  7. #End Region
  8.  
  9. #Region " Imports "
  10.  
  11. Imports System.ComponentModel
  12. Imports System.Globalization
  13.  
  14. #End Region
  15.  
  16. Public Class WebColorConverter : Inherits ColorConverter
  17.  
  18.     <DebuggerStepThrough>
  19.     Public Overrides Function GetStandardValuesSupported(context As ITypeDescriptorContext) As Boolean
  20.  
  21.         Return True
  22.     End Function
  23.  
  24.     <DebuggerStepThrough>
  25.     Public Overrides Function GetStandardValues(context As ITypeDescriptorContext) As StandardValuesCollection
  26.  
  27.         Dim collection As New Collection()
  28.  
  29.         For Each kc As KnownColor In [Enum].GetValues(GetType(KnownColor))
  30.             Dim color As Color = Color.FromKnownColor(kc)
  31.  
  32.             If Not color.IsSystemColor AndAlso color.IsNamedColor Then
  33.                 collection.Add(color)
  34.             End If
  35.         Next
  36.  
  37.         Return New StandardValuesCollection(collection)
  38.     End Function
  39.  
  40.     <DebuggerStepThrough>
  41.     Public Overrides Function ConvertTo(context As ITypeDescriptorContext,
  42.                                     culture As CultureInfo,
  43.                                     value As Object,
  44.                                     destinationType As Type) As Object
  45.  
  46.         If destinationType Is GetType(String) AndAlso TypeOf value Is Color Then
  47.             Dim color As Color = DirectCast(value, Color)
  48.             Dim html As String = If(color.A <> 255, $"#{color.A:X2}{color.R:X2}{color.G:X2}{color.B:X2}",
  49.                                     ColorTranslator.ToHtml(Color.FromArgb(color.R, color.G, color.B)))
  50.  
  51.             Dim name As String = Nothing
  52.             For Each knownColor As KnownColor In [Enum].GetValues(GetType(KnownColor))
  53.                 Dim k As Color = Color.FromKnownColor(knownColor)
  54.                 If k.A = color.A AndAlso
  55.                    k.R = color.R AndAlso
  56.                    k.G = color.G AndAlso
  57.                    k.B = color.B AndAlso Not k.IsSystemColor Then
  58.  
  59.                     name = k.Name
  60.                     Exit For
  61.                 End If
  62.             Next
  63.  
  64.             Return If(name IsNot Nothing, $"{html} ({name})", html)
  65.         End If
  66.  
  67.         Return MyBase.ConvertTo(context, culture, value, destinationType)
  68.     End Function
  69.  
  70.     <DebuggerStepThrough>
  71.     Public Overrides Function ConvertFrom(context As ITypeDescriptorContext,
  72.                                           culture As CultureInfo,
  73.                                           value As Object) As Object
  74.  
  75.         Dim s As String = TryCast(value, String)
  76.         If s IsNot Nothing Then
  77.             s = s.Trim()
  78.  
  79.             ' If input is like "xxx (Name)" remove the part in parentheses
  80.             Dim idx As Integer = s.IndexOf("("c)
  81.             If idx >= 0 Then
  82.                 s = s.Substring(0, idx).Trim()
  83.             End If
  84.  
  85.             If s.StartsWith("#") Then
  86.                 Dim hx As String = s.Substring(1).Trim()
  87.  
  88.                 ' Support #RRGGBB and #AARRGGBB
  89.                 If hx.Length = 6 Then
  90.                     Dim r As Integer = Convert.ToInt32(hx.Substring(0, 2), 16)
  91.                     Dim g As Integer = Convert.ToInt32(hx.Substring(2, 2), 16)
  92.                     Dim b As Integer = Convert.ToInt32(hx.Substring(4, 2), 16)
  93.                     Return Color.FromArgb(255, r, g, b)
  94.  
  95.                 ElseIf hx.Length = 8 Then
  96.                     Dim a As Integer = Convert.ToInt32(hx.Substring(0, 2), 16)
  97.                     Dim r As Integer = Convert.ToInt32(hx.Substring(2, 2), 16)
  98.                     Dim g As Integer = Convert.ToInt32(hx.Substring(4, 2), 16)
  99.                     Dim b As Integer = Convert.ToInt32(hx.Substring(6, 2), 16)
  100.                     Return Color.FromArgb(a, r, g, b)
  101.  
  102.                 Else
  103.                     ' Support short hex format (#RGB) by expanding to 6 digits
  104.                     If hx.Length = 3 Then
  105.                         Dim r As Integer = Convert.ToInt32(String.Concat(hx(0), hx(0)), 16)
  106.                         Dim g As Integer = Convert.ToInt32(String.Concat(hx(1), hx(1)), 16)
  107.                         Dim b As Integer = Convert.ToInt32(String.Concat(hx(2), hx(2)), 16)
  108.                         Return Color.FromArgb(255, r, g, b)
  109.                     End If
  110.                 End If
  111.  
  112.             Else
  113.                 ' Try ColorTranslator for standard names and "Transparent"
  114.                 Try
  115.                     Dim c As Color = ColorTranslator.FromHtml(s)
  116.                     ' ColorTranslator.FromHtml returns A=255 for known names; A=0 for "Transparent"
  117.                     Return c
  118.  
  119.                 Catch ex As Exception
  120.                     ' Try KnownColor enum (e.g. user types "White" or "WhiteSmoke")
  121.                     Try
  122.                         Dim kc As KnownColor
  123.                         If [Enum].TryParse(s, True, kc) Then
  124.                             Return Color.FromKnownColor(kc)
  125.                         End If
  126.                     Catch
  127.                         ' Continue to fallback
  128.                     End Try
  129.                 End Try
  130.             End If
  131.  
  132.             ' If everything fails, fallback to the base converter (throws or defaults)
  133.         End If
  134.  
  135.         Return MyBase.ConvertFrom(context, culture, value)
  136.     End Function
  137.  
  138. End Class
  139.  

WebColorEditor.vb
Código
  1. #Region " Option Statements "
  2.  
  3. Option Strict On
  4. Option Explicit On
  5. Option Infer Off
  6.  
  7. #End Region
  8.  
  9. #Region " Imports "
  10.  
  11. Imports System.ComponentModel
  12. Imports System.Drawing.Design
  13.  
  14. #End Region
  15.  
  16. Public Class WebColorEditor : Inherits UITypeEditor
  17.  
  18.     <DebuggerStepThrough>
  19.     Public Overrides Function GetEditStyle(context As ITypeDescriptorContext) As UITypeEditorEditStyle
  20.  
  21.         Return UITypeEditorEditStyle.None
  22.     End Function
  23.  
  24.     <DebuggerStepThrough>
  25.     Public Overrides Function GetPaintValueSupported(context As ITypeDescriptorContext) As Boolean
  26.  
  27.         Return True
  28.     End Function
  29.  
  30.     <DebuggerStepThrough>
  31.     Public Overrides Sub PaintValue(e As PaintValueEventArgs)
  32.  
  33.         Dim color As Color
  34.  
  35.         If TypeOf e.Value Is Color Then
  36.             color = DirectCast(e.Value, Color)
  37.         Else
  38.             Exit Sub
  39.         End If
  40.  
  41.         Using brush As New SolidBrush(color)
  42.             e.Graphics.FillRectangle(brush, e.Bounds)
  43.         End Using
  44.     End Sub
  45.  
  46. End Class

Modo de empleo:
Código
  1. Imports System.ComponentModel
  2. Imports System.Drawing.Design
  3.  
  4. Public Class Form1
  5.  
  6.     Private ReadOnly ClassTest As New MyClassTest
  7.  
  8.     Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  9.  
  10.         Me.PropertyGrid1.SelectedObject = Me.ClassTest
  11.     End Sub
  12.  
  13.     Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
  14.  
  15.         Me.ClassTest.MyColor = Color.FromArgb(255, 116, 222, 4)
  16.         Me.PropertyGrid1.Refresh()
  17.     End Sub
  18. End Class
  19.  
  20. Friend NotInheritable Class MyClassTest
  21.  
  22.     <TypeConverter(GetType(WebColorConverter))>
  23.     <Editor(GetType(WebColorEditor), GetType(UITypeEditor))> ' El editor es opcional.
  24.     Public Property MyColor As Color = Color.Transparent
  25.  
  26. End Class

Ejemplo de utilidad en la vida real: un programa open-source para mostrar en tiempo real el color del pixel actual en la pantalla (entre otras cosas):
« Última modificación: 9 Diciembre 2025, 09:30 am por Eleкtro » En línea


Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.981



Ver Perfil
Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
« Respuesta #611 en: 11 Diciembre 2025, 16:42 pm »
Un par de funciones auxiliares relacionadas con la colorimetría...

Calcula el color promedio de un área rectangular especificada dentro de un Bitmap:
Código
  1. ''' <summary>
  2. ''' Calculates the average color of a specified rectangular area within a <see cref="Bitmap"/>.
  3. ''' </summary>
  4. ''' 
  5. ''' <param name="bmp">
  6. ''' The <see cref="Bitmap"/> from which to sample colors.
  7. ''' </param>
  8. ''' 
  9. ''' <param name="rectF">
  10. ''' The rectangular area (<see cref="RectangleF"/>) to sample. 
  11. ''' <para></para>
  12. ''' The rectangle is automatically clamped to the bitmap bounds.
  13. ''' </param>
  14. ''' 
  15. ''' <param name="background">
  16. ''' Optional background color for compositing.
  17. ''' <para></para>
  18. ''' If not provided or <see cref="Color.Empty"/>, <see cref="Color.Black"/> is assumed.
  19. ''' </param>
  20. ''' 
  21. ''' <returns>
  22. ''' A <see cref="Color"/> representing the average ARGB color of all pixels in the specified area.
  23. ''' <para></para>
  24. ''' If the rectangle is empty or outside the bitmap, returns <see cref="Color.Black"/>.
  25. ''' </returns>
  26. <DebuggerStepThrough>
  27. Public Shared Function GetAverageColor(bmp As Bitmap, rectF As RectangleF,
  28.                                        Optional background As Color = Nothing) As Color
  29.  
  30.     Dim rect As Rectangle = Rectangle.Intersect(Rectangle.Round(rectF), New Rectangle(0, 0, bmp.Width, bmp.Height))
  31.     If rect.Width <= 0 OrElse rect.Height <= 0 Then
  32.         Return Color.Black
  33.     End If
  34.  
  35.     Dim bgColor As Color = If(background = Color.Empty, Color.Black, background)
  36.  
  37.     Dim aSum As Double
  38.     Dim rSum As Double
  39.     Dim gSum As Double
  40.     Dim bSum As Double = 0
  41.     Dim count As Integer = rect.Width * rect.Height
  42.  
  43.     ' Lock the bitmap for direct memory access
  44.     Dim bmpData As BitmapData = bmp.LockBits(rect, ImageLockMode.ReadOnly, bmp.PixelFormat)
  45.     Dim bytesPerPixel As Integer = Image.GetPixelFormatSize(bmp.PixelFormat) \ 8
  46.     Dim stride As Integer = bmpData.Stride
  47.     Dim scan0 As IntPtr = bmpData.Scan0
  48.  
  49.     Dim buffer((stride * rect.Height) - 1) As Byte
  50.     Marshal.Copy(scan0, buffer, 0, buffer.Length)
  51.  
  52.     For y As Integer = 0 To rect.Height - 1
  53.         For x As Integer = 0 To rect.Width - 1
  54.             Dim i As Integer = y * stride + x * bytesPerPixel
  55.             Dim b As Byte = buffer(i)
  56.             Dim g As Byte = buffer(i + 1)
  57.             Dim r As Byte = buffer(i + 2)
  58.             Dim a As Byte = If(bytesPerPixel >= 4, buffer(i + 3), CByte(255))
  59.  
  60.             Dim alphaFactor As Double = a / 255.0
  61.             rSum += r * alphaFactor + bgColor.R * (1 - alphaFactor)
  62.             gSum += g * alphaFactor + bgColor.G * (1 - alphaFactor)
  63.             bSum += b * alphaFactor + bgColor.B * (1 - alphaFactor)
  64.             aSum += a
  65.         Next
  66.     Next
  67.  
  68.     bmp.UnlockBits(bmpData)
  69.  
  70.     Dim avgA As Integer = CInt(aSum / count)
  71.     Dim avgR As Integer = CInt(rSum / count)
  72.     Dim avgG As Integer = CInt(gSum / count)
  73.     Dim avgB As Integer = CInt(bSum / count)
  74.  
  75.     Return Color.FromArgb(avgA, avgR, avgG, avgB)
  76. End Function

Calcula la luminancia percibida de un color, opcionalmente compuesta sobre un color de fondo:
Código
  1. ''' <summary>
  2. ''' Calculates the perceived luminance of a color, optionally composited over a background color.
  3. ''' </summary>
  4. ''' 
  5. ''' <param name="color">
  6. ''' The color whose luminance is to be calculated. Includes alpha channel.
  7. ''' </param>
  8. ''' 
  9. ''' <param name="background">
  10. ''' Optional background color for compositing.
  11. ''' <para></para>
  12. ''' If not provided or <see cref="Color.Empty"/>, <see cref="Color.Black"/> is assumed.
  13. ''' </param>
  14. ''' 
  15. ''' <returns>
  16. ''' A <see cref="Double"/> representing the relative luminance of the color in the range 0.0 (black) to 1.0 (white).
  17. ''' </returns>
  18. <DebuggerStepThrough>
  19. Public Shared Function GetLuminance(color As Color, Optional background As Color = Nothing) As Double
  20.  
  21.     Dim bgColor As Color = If(background = Color.Empty, Color.Black, background)
  22.  
  23.     Dim alpha As Double = color.A / 255.0
  24.     Dim r As Double = color.R * alpha + bgColor.R * (1 - alpha)
  25.     Dim g As Double = color.G * alpha + bgColor.G * (1 - alpha)
  26.     Dim b As Double = color.B * alpha + bgColor.B * (1 - alpha)
  27.  
  28.     ' Standard luma weighting associated with Rec. 601 when deriving brightness from RGB.
  29.     ' Y'601 = 0.299 R' + 0.587 G' + 0.114 B'.
  30.     ' https://en.wikipedia.org/wiki/Rec._601
  31.     ' https://gmao.gsfc.nasa.gov/media/gmaoftp/jkolassa/Matlab_scripts/colorspace.html
  32.     Dim luminance As Double = (0.299 * r +
  33.                                0.587 * g +
  34.                                0.114 * b
  35.                               ) / 255.0
  36.  
  37.     Return luminance
  38. End Function
En línea


Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.981



Ver Perfil
Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
« Respuesta #612 en: 11 Diciembre 2025, 16:49 pm »
Una forma universal y personalizable para reportar progreso en nuestro icono del área de notificación (system tray)...

Importante: recomiendo no usar más de dos caracteres para el texto. Con tres caracteres ya se achica mucho, y con más, se vuelve prácticamente imposible de leer. Hay muy poco espacio legible para un icono de 32x32px.

                   

NotifyIconProgressBar.vb
Código
  1. Public Structure NotifyIconProgressBar
  2.  
  3.     Public Height As Integer
  4.     Public BackColor As Color
  5.     Public ForeColor As Color
  6.     Public FillColor As Color
  7.     Public BorderColor As Color
  8.     Public BorderWidth As Integer
  9.  
  10.     Public Shared ReadOnly Property Empty As NotifyIconProgressBar
  11.         Get
  12.             Return New NotifyIconProgressBar With {
  13.                 .Height = 0,
  14.                 .BackColor = Color.Empty,
  15.                 .ForeColor = Color.Empty,
  16.                 .FillColor = Color.Empty,
  17.                 .BorderColor = Color.Empty,
  18.                 .BorderWidth = 0
  19.             }
  20.         End Get
  21.     End Property
  22.  
  23. End Structure

P/invokes:
Código
  1. <DllImport("user32.dll", SetLastError:=True)>
  2. Private Shared Function DestroyIcon(hIcon As IntPtr) As Boolean
  3. End Function

El método principal:
Código
  1. Imports System.Drawing.Drawing2D
  2. Imports System.Drawing.Text
  3. Imports System.Runtime.InteropServices
  4.  
  5. ''' <summary>
  6. ''' Renders a progress bar overlay on a <see cref="NotifyIcon"/> and optionally draws text on it.
  7. ''' </summary>
  8. ''' 
  9. ''' <param name="ntfy">
  10. ''' The <see cref="NotifyIcon"/> whose icon will be updated with the rendered progress bar.
  11. ''' </param>
  12. ''' 
  13. ''' <param name="progressBar">
  14. ''' A <see cref="NotifyIconProgressBar"/> structure containing the bar's height, colors and border width.
  15. ''' </param>
  16. ''' 
  17. ''' <param name="value">
  18. ''' The current position of the progress bar.
  19. ''' </param>
  20. ''' 
  21. ''' <param name="maximumValue">
  22. ''' The maximum <paramref name="value"/> range of the progress bar.
  23. ''' </param>
  24. ''' 
  25. ''' <param name="text">
  26. ''' Optional text to display centered above the progress bar.
  27. ''' Must be 3 characters or fewer if provided.
  28. ''' </param>
  29. <DebuggerStepThrough>
  30. Public Shared Sub RenderNotifyIconProgressBar(ntfy As NotifyIcon, baseIcon As Icon, progressBar As NotifyIconProgressBar,
  31.                                               value As Integer, maximumValue As Integer,
  32.                                               Optional text As String = Nothing)
  33.  
  34.     If ntfy Is Nothing Then
  35.         Throw New ArgumentNullException(NameOf(ntfy))
  36.     End If
  37.  
  38.     If baseIcon Is Nothing Then
  39.         Throw New ArgumentNullException(NameOf(baseIcon))
  40.     End If
  41.  
  42.     If maximumValue <= 0 Then
  43.         Throw New ArgumentOutOfRangeException(NameOf(maximumValue), $"{NameOf(maximumValue)} must be greater than zero.")
  44.     End If
  45.  
  46.     If value < 0 OrElse (value > maximumValue) Then
  47.         Throw New ArgumentOutOfRangeException(NameOf(value), $"{NameOf(value)} must be between zero and {NameOf(maximumValue)}.")
  48.     End If
  49.  
  50.     Dim currentIcon As Icon = ntfy.Icon
  51.  
  52.     Using bmp As Bitmap = baseIcon.ToBitmap()
  53.  
  54.         Dim width As Integer = bmp.Width
  55.         Dim height As Integer = bmp.Height
  56.  
  57.         If progressBar.Height <= 0 Then
  58.             Throw New ArgumentOutOfRangeException(NameOf(progressBar.Height), $"{NameOf(progressBar.Height)} must be greater than zero.")
  59.         End If
  60.  
  61.         If progressBar.Height > height Then
  62.             Throw New ArgumentOutOfRangeException(NameOf(progressBar.Height), $"{NameOf(progressBar.Height)} ({progressBar.Height}) exceeds the icon height ({height}).")
  63.         End If
  64.  
  65.         If progressBar.BorderWidth > height Then
  66.             Throw New ArgumentOutOfRangeException(NameOf(progressBar.BorderWidth), $"{NameOf(progressBar.BorderWidth)} ({progressBar.BorderWidth}) exceeds the icon height ({height}).")
  67.         End If
  68.  
  69.         Using g As Graphics = Graphics.FromImage(bmp)
  70.             g.CompositingMode = CompositingMode.SourceOver
  71.             g.CompositingQuality = CompositingQuality.HighQuality
  72.             g.InterpolationMode = InterpolationMode.High
  73.             g.PixelOffsetMode = PixelOffsetMode.Half
  74.             g.SmoothingMode = SmoothingMode.AntiAlias
  75.             g.TextRenderingHint = TextRenderingHint.ClearTypeGridFit
  76.  
  77.             Dim barY As Integer = height - progressBar.Height
  78.  
  79.             Using backgroundBrush As New SolidBrush(progressBar.BackColor)
  80.                 g.FillRectangle(backgroundBrush, 0, barY, width, progressBar.Height)
  81.             End Using
  82.  
  83.             Using fillBrush As New SolidBrush(progressBar.FillColor)
  84.                 Dim percent As Single = CSng(value / maximumValue)
  85.                 Dim filledWidth As Integer = CInt(width * percent)
  86.                 g.FillRectangle(fillBrush, 0, barY, filledWidth, progressBar.Height)
  87.             End Using
  88.  
  89.             If progressBar.BorderWidth > 0 Then
  90.                 Using borderPen As New Pen(progressBar.BorderColor, progressBar.BorderWidth)
  91.                     g.DrawRectangle(borderPen, 0, barY, width - 1, progressBar.Height)
  92.                 End Using
  93.             End If
  94.  
  95.             If Not String.IsNullOrWhiteSpace(text) Then
  96.  
  97.                 Using fontFamily As New FontFamily("Segoe UI")
  98.                     Dim fontStyle As FontStyle = FontStyle.Bold
  99.  
  100.                     Dim layoutRect As New RectangleF(0, 0, width, height)
  101.                     Dim fontSizePx As Single = ComputeMaxFontSizeForRectangle(g, text, fontFamily, fontStyle, layoutRect)
  102.  
  103.                     Using font As New Font(fontFamily, fontSizePx, fontStyle, GraphicsUnit.Pixel)
  104.  
  105.                         Using gp As New GraphicsPath()
  106.                             Dim sf As New StringFormat() With {
  107.                                 .Alignment = StringAlignment.Center,
  108.                                 .LineAlignment = StringAlignment.Center
  109.                             }
  110.                             gp.AddString(text, font.FontFamily, font.Style, font.Size, layoutRect, sf)
  111.  
  112.                             ' Outline then fill for best legibility
  113.                             Using outlinePen As New Pen(Color.FromArgb(220, Color.Black), Math.Max(1.0F, fontSizePx * 0.18F))
  114.                                 outlinePen.LineJoin = LineJoin.Round
  115.                                 g.DrawPath(outlinePen, gp)
  116.                             End Using
  117.  
  118.                             Using foregroundBrush As New SolidBrush(progressBar.ForeColor)
  119.                                 g.FillPath(foregroundBrush, gp)
  120.                             End Using
  121.                         End Using
  122.                     End Using
  123.                 End Using
  124.             End If
  125.         End Using
  126.  
  127.         Dim hIcon As IntPtr = bmp.GetHicon()
  128.         Using tempIcon As Icon = Icon.FromHandle(hIcon)
  129.             Dim finalIcon As Icon = CType(tempIcon.Clone(), Icon)
  130.             DestroyIcon(hIcon)
  131.             ntfy.Icon = finalIcon
  132.         End Using
  133.  
  134.         currentIcon.Dispose()
  135.     End Using
  136. End Sub

Función auxiliar necesaria:
Código
  1. ''' <summary>
  2. ''' Determines the largest font size that allows the specified text to fit entirely 
  3. ''' within the given rectangle when drawn using the provided <see cref="Graphics"/> object.
  4. ''' </summary>
  5. ''' 
  6. ''' <param name="g">
  7. ''' The source <see cref="Graphics"/> object used to measure the text.
  8. ''' </param>
  9. ''' 
  10. ''' <param name="text">
  11. ''' The text to measure.
  12. ''' </param>
  13. ''' 
  14. ''' <param name="fontFamily">
  15. ''' The font family to use (e.g., "Segoe UI").
  16. ''' </param>
  17. ''' 
  18. ''' <param name="fontStyle">
  19. ''' The font style (e.g., <see cref="FontStyle.Regular"/>).
  20. ''' </param>
  21. ''' 
  22. ''' <param name="layoutRectangle">
  23. ''' The rectangle within which the text must fit.
  24. ''' </param>
  25. ''' 
  26. ''' <param name="minimumSize">
  27. ''' The minimum allowed font size (in <see cref="GraphicsUnit.Pixel"/>).
  28. ''' <para></para>
  29. ''' If the text does not fit even at this size, the function returns this value.
  30. ''' <para></para>
  31. ''' Default value is <c>1.0</c>.
  32. ''' </param>
  33. ''' 
  34. ''' <param name="tolerance">
  35. ''' The precision threshold for how closely the function tries to fit the text in the rectangle, in <see cref="GraphicsUnit.Pixel"/>.
  36. ''' <para></para>
  37. ''' Smaller values gives more exact results but will require more time to compute.
  38. ''' <para></para>
  39. ''' Default value is <c>0.5</c>.
  40. ''' </param>
  41. ''' 
  42. ''' <returns>
  43. ''' The largest font size in <see cref="GraphicsUnit.Pixel"/> that fits the text inside the rectangle.
  44. ''' <para></para>
  45. ''' If the text cannot fit even at <paramref name="minimumSize"/>, that minimum value is returned.
  46. ''' </returns>
  47. Public Shared Function ComputeMaxFontSizeForRectangle(g As Graphics, text As String,
  48.                                                       fontFamily As FontFamily, fontStyle As FontStyle,
  49.                                                       layoutRectangle As RectangleF,
  50.                                                       Optional minimumSize As Single = 1.0F,
  51.                                                       Optional tolerance As Single = 0.5F) As Single
  52.  
  53.     Dim minSize As Single = minimumSize
  54.     Dim maxSize As Single = layoutRectangle.Height
  55.     Dim bestFit As Single = minSize
  56.  
  57.     While (maxSize - minSize) > tolerance
  58.         Dim midSize As Single = (minSize + maxSize) / 2
  59.  
  60.         Using testFont As New Font(fontFamily, midSize, fontStyle, GraphicsUnit.Pixel)
  61.             Dim textSize As SizeF = g.MeasureString(text, testFont)
  62.  
  63.             If (textSize.Width <= layoutRectangle.Width) AndAlso
  64.                (textSize.Height <= layoutRectangle.Height) Then
  65.                 bestFit = midSize
  66.                 minSize = midSize
  67.             Else
  68.                 maxSize = midSize
  69.             End If
  70.         End Using
  71.     End While
  72.  
  73.     Return Math.Max(minimumSize, bestFit)
  74. End Function

Ejemplo de uso:
Código
  1. Private Async Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  2.  
  3.     Dim progressBar As New NotifyIconProgressBar With {
  4.         .Height = 32,
  5.         .BackColor = Color.Transparent,
  6.         .ForeColor = Color.White,
  7.         .FillColor = Color.LimeGreen
  8.     }
  9.  
  10.     Dim ntfy As NotifyIcon = Me.NotifyIcon1
  11.     Dim baseIcon As Icon = DirectCast(ntfy.Icon.Clone(), Icon)
  12.  
  13.     Dim maxValue As Integer = 100
  14.     For i As Integer = 0 To maxValue
  15.         RenderNotifyIconProgressBar(ntfy, baseIcon, progressBar, i, maxValue, CStr(i))
  16.         Await Task.Delay(100)
  17.     Next
  18. End Sub
« Última modificación: 11 Diciembre 2025, 18:17 pm por Eleкtro » En línea


Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.981



Ver Perfil
Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
« Respuesta #613 en: 18 Enero 2026, 22:14 pm »
FlexibleSettingsProvider

Un proveedor de configuración que permite almacenar el archivo de configuración de usuario "user.config" en un directorio y nombre de archivo personalizables, asegurando que la ubicación de la configuración se mantenga fija y predecible.

Este proveedor nos permite - si así lo queremos - establecer el directorio base de nuestra aplicación, haciendo que podamos portabilizar nuestra aplicación junto al archivo de configuración de usuario.

Código
  1. #Region " Option Statements "
  2.  
  3. Option Explicit On
  4. Option Strict On
  5. Option Infer Off
  6.  
  7. #End Region
  8.  
  9. #Region " Imports "
  10.  
  11. Imports System.Collections.Specialized
  12. Imports System.ComponentModel
  13. Imports System.Configuration
  14. Imports System.IO
  15. Imports System.Reflection
  16. Imports System.Runtime.InteropServices
  17. Imports System.Security
  18. Imports System.Security.AccessControl
  19. Imports System.Security.Cryptography
  20. Imports System.Security.Principal
  21. Imports System.Text
  22.  
  23. #End Region
  24.  
  25. #Region " FlexibleSettingsProvider "
  26.  
  27. ''' <summary>
  28. ''' A settings provider that allows to store the application's user configuration file 
  29. ''' in a user-defined directory path and file name, ensuring the configuration location remains 
  30. ''' predictable across application updates.
  31. ''' </summary>
  32. ''' 
  33. ''' <example> This is a code example.
  34. ''' <code language="VB">
  35. ''' '------------------------------------------------------------------------------
  36. ''' ' <auto-generated>
  37. ''' '     This code was generated by a tool.
  38. ''' '     Runtime Version:4.0.30319.42000
  39. ''' '
  40. ''' '     Changes to this file may cause incorrect behavior and will be lost if
  41. ''' '     the code is regenerated.
  42. ''' ' </auto-generated>
  43. ''' '------------------------------------------------------------------------------
  44. ''' Namespace My
  45. '''     
  46. '''     &lt;Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(),  _
  47. '''      Global.System.CodeDom.Compiler.GeneratedCodeAttribute("Microsoft.VisualStudio.Editors.SettingsDesigner.SettingsSingleFileGenerator", "17.14.0.0"),  _
  48. '''      Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)&gt;  _
  49. '''     Partial Friend NotInheritable Class MySettings
  50. '''         Inherits Global.System.Configuration.ApplicationSettingsBase
  51. '''         
  52. '''         ' ...
  53. '''     End Class
  54. ''' End Namespace
  55. ''' 
  56. ''' ' &#9940; DO NOT MODIFY THE AUTO-GENERATED DESIGNER FILE ABOVE. 
  57. ''' ' INSTEAD, PLACE THE FOLLOWING NAMESPACE IN A SEPARATE PART OF YOUR SOURCE CODE:
  58. ''' 
  59. ''' Namespace My
  60. ''' 
  61. '''     &lt;Global.System.Configuration.SettingsProvider(GetType(FlexibleSettingsProvider))&gt;
  62. '''     Partial Friend NotInheritable Class MySettings
  63. ''' 
  64. '''         Public Sub New()
  65. '''             FlexibleSettingsProvider.BaseDirectoryPath = ".\"
  66. '''             FlexibleSettingsProvider.DirectoryName = ""
  67. '''             FlexibleSettingsProvider.DirectoryNameFlags = SettingsDirectoryNameFlags.None
  68. '''             FlexibleSettingsProvider.FileName = "user.config"
  69. ''' 
  70. '''             Debug.WriteLine($"Effective config file path: {FlexibleSettingsProvider.EffectiveConfigFilePath}")
  71. '''         End Sub
  72. ''' 
  73. '''     End Class
  74. ''' End Namespace
  75. ''' </code>
  76. ''' </example>
  77. ''' 
  78. ''' <example> This is a code example.
  79. ''' <code language="CSharp">
  80. ''' 
  81. ''' //------------------------------------------------------------------------------
  82. ''' // <auto-generated>
  83. ''' //     This code was generated by a tool.
  84. ''' //     Runtime Version:4.0.30319.42000
  85. ''' //
  86. ''' //     Changes to this file may cause incorrect behavior and will be lost if
  87. ''' //     the code is regenerated.
  88. ''' // </auto-generated>
  89. ''' //------------------------------------------------------------------------------
  90. '''
  91. ''' namespace WindowsFormsApp1.Properties {
  92. '''     
  93. '''     [global::System.Runtime.CompilerServices.CompilerGeneratedAttribute()]
  94. '''     [global::System.CodeDom.Compiler.GeneratedCodeAttribute("Microsoft.VisualStudio.Editors.SettingsDesigner.SettingsSingleFileGenerator", "17.14.0.0")]
  95. '''     internal sealed partial class Settings : global::System.Configuration.ApplicationSettingsBase {
  96. '''         // ...
  97. '''     }
  98. ''' }
  99. ''' 
  100. ''' // &#9940; DO NOT MODIFY THE AUTO-GENERATED DESIGNER FILE ABOVE. 
  101. ''' // INSTEAD, PLACE THE FOLLOWING NAMESPACE IN A SEPARATE PART OF YOUR SOURCE CODE:
  102. ''' 
  103. ''' namespace WindowsFormsApp1.Properties
  104. ''' {
  105. '''     [SettingsProvider(typeof(FlexibleSettingsProvider))]
  106. '''     internal sealed partial class Settings : global::System.Configuration.ApplicationSettingsBase
  107. '''     {
  108. '''         public Settings()
  109. '''         {
  110. '''             FlexibleSettingsProvider.BaseDirectoryPath = @".\";
  111. '''             FlexibleSettingsProvider.DirectoryName = string.Empty;
  112. '''             FlexibleSettingsProvider.DirectoryNameFlags = SettingsDirectoryNameFlags.None;
  113. '''             FlexibleSettingsProvider.FileName = "user.config";
  114. '''
  115. '''             Debug.WriteLine($"Effective config file path: {FlexibleSettingsProvider.EffectiveConfigFilePath}");
  116. '''         }
  117. '''     }
  118. ''' }
  119. ''' </code>
  120. ''' </example>
  121. Public Class FlexibleSettingsProvider : Inherits SettingsProvider
  122.  
  123. #Region " Private Fields "
  124.  
  125.     ''' <summary>
  126.     ''' The default base directory path to use when the path specified by 
  127.     ''' <see cref="FlexibleSettingsProvider.BaseDirectoryPath"/> is null or cannot be accessed.
  128.     ''' </summary>
  129.     Private Shared ReadOnly DefaultBaseDirectoryPath As String =
  130.         Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) ' Note: THIS VALUE CANNOT BE NULL.
  131.  
  132.     ''' <summary>
  133.     ''' The default configuration file name to use when the name specified by 
  134.     ''' <see cref="FlexibleSettingsProvider.FileName"/> is null.
  135.     ''' </summary>
  136.     Private Shared ReadOnly DefaultFileName As String = "user.config" ' Note: THIS VALUE CANNOT BE NULL.
  137.  
  138. #End Region
  139.  
  140. #Region " Public Properties "
  141.  
  142.     ''' <summary>
  143.     ''' Gets or sets the base directory path where the settings storage folder specified by 
  144.     ''' <see cref="FlexibleSettingsProvider.DirectoryName"/> property will be created.
  145.     ''' </summary>
  146.     ''' 
  147.     ''' <remarks>
  148.     ''' This can be a relative path, for example <b>".\"</b>, which refers to the current application's base directory.
  149.     ''' <para></para>
  150.     ''' If this value is null or empty, <see cref="Environment.SpecialFolder.LocalApplicationData"/> directory path will be used.
  151.     ''' <para></para>
  152.     ''' Default value is <b>".\"</b>.
  153.     ''' </remarks>
  154.     Public Shared Property BaseDirectoryPath As String = ".\"
  155.  
  156.     ''' <summary>
  157.     ''' Gets or sets the name of the settings storage folder that will be created under the 
  158.     ''' base directory path specified by <see cref="FlexibleSettingsProvider.BaseDirectoryPath"/> property; 
  159.     ''' For example, <b>"My Application"</b>.
  160.     ''' </summary>
  161.     ''' 
  162.     ''' <remarks>
  163.     ''' This value can be null, in which case this folder will not be created at all.
  164.     ''' <para></para>
  165.     ''' Default value is null.
  166.     ''' </remarks>
  167.     Public Shared Property DirectoryName As String = Nothing
  168.  
  169.     ''' <summary>
  170.     ''' Gets or sets additional flags that allows to automatically append extra information to the 
  171.     ''' settings storage folder name specified by <see cref="FlexibleSettingsProvider.DirectoryName"/> property.
  172.     ''' <para></para>
  173.     ''' Default value is <see cref="SettingsDirectoryNameFlags.None"/>.
  174.     ''' </summary>
  175.     Public Shared Property DirectoryNameFlags As SettingsDirectoryNameFlags = SettingsDirectoryNameFlags.None
  176.  
  177.     ''' <summary>
  178.     ''' Gets or sets the name of the user configuration file to create inside the 
  179.     ''' settings storage folder specified by <see cref="FlexibleSettingsProvider.DirectoryName"/> property.
  180.     ''' <para></para>
  181.     ''' If this value is null or empty, <b>"user.config"</b> is used.
  182.     ''' <para></para>
  183.     ''' Default value is <b>"user.config"</b>.
  184.     ''' </summary>
  185.     Public Shared Property FileName As String = FlexibleSettingsProvider.DefaultFileName
  186.  
  187.     ''' <summary>
  188.     ''' Gets or sets the type of <see cref="HashAlgorithm"/> to use for appending the hash suffix to the 
  189.     ''' settings storage folder name specified by <see cref="FlexibleSettingsProvider.DirectoryName"/> when 
  190.     ''' <see cref="FlexibleSettingsProvider.DirectoryNameFlags"/> contains <see cref="SettingsDirectoryNameFlags.Hash"/> flag.
  191.     ''' <para></para>
  192.     ''' Default value is <see cref="MD5"/>.
  193.     ''' </summary>
  194.     Public Shared Property HashAlgorithmType As Type = GetType(MD5)
  195.  
  196.     ''' <summary>
  197.     ''' Gets or sets the maximum character length to use for appending the hash suffix to the 
  198.     ''' settings storage folder name specified by <see cref="FlexibleSettingsProvider.DirectoryName"/> when 
  199.     ''' <see cref="FlexibleSettingsProvider.DirectoryNameFlags"/> contains <see cref="SettingsDirectoryNameFlags.Hash"/> flag.
  200.     ''' <see cref="SettingsDirectoryNameFlags.Hash"/> flag.
  201.     ''' <para></para>
  202.     ''' Default value is <b>8</b>.
  203.     ''' </summary>
  204.     ''' 
  205.     ''' <remarks>
  206.     ''' Note: If the specified length exceeds the maximum length supported by the hash algorithm specified by
  207.     ''' <see cref="FlexibleSettingsProvider.HashAlgorithmType"/> property, 
  208.     ''' the value is automatically truncated to the maximum allowed.
  209.     ''' </remarks>
  210.     Public Shared Property HashLength As Integer = 8
  211.  
  212.     ''' <summary>
  213.     ''' Gets the effective full path to the user configuration file 
  214.     ''' using the current rules specified by 
  215.     ''' <see cref="FlexibleSettingsProvider.BaseDirectoryPath"/>,
  216.     ''' <see cref="FlexibleSettingsProvider.DirectoryName"/> ,
  217.     ''' <see cref="FlexibleSettingsProvider.DirectoryNameFlags"/>,
  218.     ''' <see cref="FlexibleSettingsProvider.FileName"/>,
  219.     ''' <see cref="FlexibleSettingsProvider.HashAlgorithmType"/> and 
  220.     ''' <see cref="FlexibleSettingsProvider.HashLength"/> properties; 
  221.     ''' For example, <b>"C:\Users\{USERNAME}\AppData\Local\My Application\user.config"</b>
  222.     ''' </summary>
  223.     Public Shared ReadOnly Property EffectiveConfigFilePath As String
  224.         <DebuggerStepThrough>
  225.         Get
  226.             Return FlexibleSettingsProvider.GetEffectiveConfigFilePath()
  227.         End Get
  228.     End Property
  229.  
  230.     ''' <summary>
  231.     ''' Gets the name of the currently running application
  232.     ''' using the current rules specified by 
  233.     ''' <see cref="FlexibleSettingsProvider.DirectoryName"/> ,
  234.     ''' <see cref="FlexibleSettingsProvider.DirectoryNameFlags"/>,
  235.     ''' <see cref="FlexibleSettingsProvider.HashAlgorithmType"/> and 
  236.     ''' <see cref="FlexibleSettingsProvider.HashLength"/> properties; 
  237.     ''' For example, <b>"My Application"</b>.
  238.     ''' </summary>
  239.     <EditorBrowsable(EditorBrowsableState.Never)>
  240.     Public Overrides Property ApplicationName As String
  241.         <DebuggerStepThrough>
  242.         Get
  243.             Return FlexibleSettingsProvider.GetEffectiveDirectoryName()
  244.         End Get
  245.         <DebuggerStepThrough>
  246.         Set(value As String)
  247.             ' Intentionally ignored, and required.
  248.         End Set
  249.     End Property
  250.  
  251.     ''' <summary>
  252.     ''' Gets a brief, friendly description of this <see cref="SettingsProvider"/>,
  253.     ''' suitable for display in administrative tools or other user interfaces (UIs).
  254.     ''' </summary>
  255.     <EditorBrowsable(EditorBrowsableState.Never)>
  256.     Public Overrides ReadOnly Property Description As String
  257.         <DebuggerStepThrough>
  258.         Get
  259.             Return If(Not String.IsNullOrEmpty(Me._Description), Me._Description, Me.Name)
  260.         End Get
  261.     End Property
  262.     ''' <summary>
  263.     ''' ( Backing field of <see cref="Description"/> property.)
  264.     ''' <para></para>
  265.     ''' A brief, friendly description of this <see cref="SettingsProvider"/>,
  266.     ''' suitable for display in administrative tools or other user interfaces (UIs).
  267.     ''' </summary>
  268.     Private ReadOnly _Description As String =
  269.         "A settings provider that allows to store the application's user configuration file in a user-defined directory path and file name."
  270.  
  271. #End Region
  272.  
  273. #Region " Constructors "
  274.  
  275.     ''' <summary>
  276.     ''' Initializes a new instance of the <see cref="FlexibleSettingsProvider"/> class.
  277.     ''' </summary>
  278.     <DebuggerNonUserCode>
  279.     Public Sub New()
  280.     End Sub
  281.  
  282. #End Region
  283.  
  284. #Region " Public Methods "
  285.  
  286.     ''' <summary>
  287.     ''' Initializes the configuration builder.
  288.     ''' </summary>
  289.     ''' 
  290.     ''' <param name="name">
  291.     ''' The friendly name of the provider.
  292.     ''' </param>
  293.     ''' 
  294.     ''' <param name="config">
  295.     ''' A collection of the name/value pairs representing the provider-specific attributes 
  296.     ''' specified in the configuration for this provider.
  297.     ''' </param>
  298.     <DebuggerStepperBoundary>
  299.     Public Overrides Sub Initialize(name As String, config As NameValueCollection)
  300.  
  301.         If String.IsNullOrEmpty(name) Then
  302.             name = NameOf(FlexibleSettingsProvider)
  303.         End If
  304.         MyBase.Initialize(name, config)
  305.     End Sub
  306.  
  307.     ''' <summary>
  308.     ''' Returns the collection of settings property values for the specified application instance and settings property group.
  309.     ''' </summary>
  310.     ''' 
  311.     ''' <param name="context">
  312.     ''' A <see cref="SettingsContext"/> describing the current application use.
  313.     ''' </param>
  314.     ''' 
  315.     ''' <param name="properties">
  316.     ''' A <see cref="SettingsPropertyCollection"/> containing the settings property group whose values are to be retrieved.
  317.     ''' </param>
  318.     ''' <returns>
  319.     ''' A <see cref="SettingsPropertyValueCollection"/> containing the values for the specified settings property group.
  320.     ''' </returns>
  321.     <DebuggerStepperBoundary>
  322.     Public Overrides Function GetPropertyValues(context As SettingsContext, properties As SettingsPropertyCollection) As SettingsPropertyValueCollection
  323.  
  324.         Dim values As New SettingsPropertyValueCollection()
  325.  
  326.         Dim doc As XDocument = Nothing
  327.  
  328.         Dim effectiveConfigFilePath As String = FlexibleSettingsProvider.EffectiveConfigFilePath()
  329.  
  330.         If File.Exists(effectiveConfigFilePath) Then
  331.             Try
  332.                 Using fs As New FileStream(effectiveConfigFilePath, FileMode.Open, FileAccess.Read, FileShare.Read)
  333.                     doc = XDocument.Load(fs)
  334.                 End Using
  335.             Catch ex As Exception
  336.                 ' If file is corrupt / unreadable, recreate a fresh doc.
  337.                 doc = New XDocument(New XElement("settings"))
  338.             End Try
  339.         Else
  340.             doc = New XDocument(New XElement("settings"))
  341.         End If
  342.  
  343.         ' Ensure root exists.
  344.         If doc.Root Is Nothing Then
  345.             doc = New XDocument(New XElement("settings"))
  346.         End If
  347.  
  348.         For Each prop As SettingsProperty In properties
  349.             Dim el As XElement = doc.Root.Element(prop.Name)
  350.             Dim value As Object = If(el IsNot Nothing, el.Value, prop.DefaultValue)
  351.  
  352.             Dim spv As New SettingsPropertyValue(prop) With {
  353.                 .SerializedValue = value
  354.             }
  355.             values.Add(spv)
  356.         Next
  357.  
  358.         Return values
  359.     End Function
  360.  
  361.     ''' <summary>
  362.     ''' Sets the values of the specified group of property settings.
  363.     ''' </summary>
  364.     ''' 
  365.     ''' <param name="context">
  366.     ''' A <see cref="SettingsContext"/> describing the current application use.
  367.     ''' </param>
  368.     ''' 
  369.     ''' <param name="values">
  370.     ''' A <see cref="SettingsPropertyValueCollection"/> representing the group of property settings to set.
  371.     ''' </param>
  372.     <DebuggerStepperBoundary>
  373.     Public Overrides Sub SetPropertyValues(context As SettingsContext, values As SettingsPropertyValueCollection)
  374.  
  375.         Dim effectiveConfigFilePath As String = FlexibleSettingsProvider.EffectiveConfigFilePath()
  376.         Dim directoryPath As String = Path.GetDirectoryName(effectiveConfigFilePath)
  377.         If Not Directory.Exists(directoryPath) Then
  378.             Directory.CreateDirectory(directoryPath)
  379.         End If
  380.  
  381.         Dim root As New XElement("settings")
  382.  
  383.         For Each val As SettingsPropertyValue In values
  384.             Dim nodeName As String = If(val.Property IsNot Nothing AndAlso Not String.IsNullOrEmpty(val.Property.Name),
  385.                                         val.Property.Name,
  386.                                         "unknown")
  387.  
  388.             Dim nodeValue As String = If(val.SerializedValue Is Nothing, "", val.SerializedValue.ToString())
  389.  
  390.             root.Add(New XElement(nodeName, nodeValue))
  391.         Next
  392.  
  393.         Dim doc As New XDocument(root)
  394.  
  395.         Using fs As New FileStream(effectiveConfigFilePath, FileMode.Create, FileAccess.Write, FileShare.Read)
  396.             doc.Save(fs)
  397.         End Using
  398.     End Sub
  399.  
  400. #End Region
  401.  
  402. #Region " Private Methods "
  403.  
  404.     ''' <summary>
  405.     ''' Resolves and returns the effective base directory path where the settings storage folder specified by 
  406.     ''' <see cref="FlexibleSettingsProvider.DirectoryName"/> property will be created.
  407.     ''' </summary>
  408.     ''' 
  409.     ''' <remarks>
  410.     ''' This function determines the proper directory path by first using the value specified in
  411.     ''' <see cref="FlexibleSettingsProvider.BaseDirectoryPath"/> property.
  412.     ''' <para></para>
  413.     ''' If that value is null, empty, whitespace, or the directory cannot be created, the path specified by 
  414.     ''' <see cref="FlexibleSettingsProvider.DefaultBaseDirectoryPath"/> property is used instead.
  415.     ''' </remarks>
  416.     ''' 
  417.     ''' <returns>
  418.     ''' A string representing the effective base directory path.
  419.     ''' </returns>
  420.     ''' 
  421.     ''' <exception cref="InvalidOperationException">
  422.     ''' Thrown when the provier is unable to resolve a base directory path that 
  423.     ''' exists and can grant read/write access to the current application.
  424.     ''' <para></para>
  425.     ''' This exception indicates that neither the directory specified by <see cref="FlexibleSettingsProvider.DirectoryName"/> property 
  426.     ''' nor the fallback specified by <see cref="FlexibleSettingsProvider.DefaultBaseDirectoryPath"/> property 
  427.     ''' can be used to read from and write to the location.
  428.     ''' </exception>
  429.     <DebuggerStepThrough>
  430.     Private Shared Function GetEffectiveBaseDirectoryPath() As String
  431.  
  432.         Dim currentBaseDirectoryPath As String = FlexibleSettingsProvider.BaseDirectoryPath
  433.  
  434.         ' Expand to full path.
  435.         If Not String.IsNullOrWhiteSpace(currentBaseDirectoryPath) Then
  436.             currentBaseDirectoryPath = Path.GetFullPath(currentBaseDirectoryPath)
  437.         End If
  438.  
  439.         ' Ensure the directory path is set.
  440.         If String.IsNullOrWhiteSpace(currentBaseDirectoryPath) Then
  441.             currentBaseDirectoryPath = FlexibleSettingsProvider.DefaultBaseDirectoryPath
  442.         End If
  443.  
  444.         ' Try creating the directory.
  445.         Try
  446.             Directory.CreateDirectory(currentBaseDirectoryPath)
  447.  
  448.         Catch ' If failed, fallback to LocalAppData
  449.             currentBaseDirectoryPath = FlexibleSettingsProvider.DefaultBaseDirectoryPath
  450.             Try
  451.                 Directory.CreateDirectory(currentBaseDirectoryPath)
  452.             Catch
  453.                 ' Ignore: write check will catch this later.
  454.             End Try
  455.  
  456.         End Try
  457.  
  458.         ' Verify that we can read from and write to the directory path.
  459.         If Not FlexibleSettingsProvider.CanReadAndWriteToDirectory(currentBaseDirectoryPath) Then
  460.  
  461.             Dim previousDirectoryPath As String = currentBaseDirectoryPath
  462.  
  463.             ' Switch to default directory path if not already using it.
  464.             If currentBaseDirectoryPath <> FlexibleSettingsProvider.DefaultBaseDirectoryPath Then
  465.                 currentBaseDirectoryPath = FlexibleSettingsProvider.DefaultBaseDirectoryPath
  466.             End If
  467.  
  468.             If currentBaseDirectoryPath <> previousDirectoryPath Then
  469.                 ' Throw if directory still not writable.
  470.                 If Not FlexibleSettingsProvider.CanReadAndWriteToDirectory(currentBaseDirectoryPath) Then
  471.                     Throw New InvalidOperationException(
  472.                         $"Cannot read from or write the user configuration file in directory: {currentBaseDirectoryPath}. Check user permissions.")
  473.                 End If
  474.             End If
  475.         End If
  476.  
  477.         Return currentBaseDirectoryPath
  478.     End Function
  479.  
  480.     ''' <summary>
  481.     ''' Resolves and returns the effective name of the settings storage folder that will be created under the 
  482.     ''' base directory path specified by <see cref="FlexibleSettingsProvider.BaseDirectoryPath"/> property, 
  483.     ''' applying the rules specified by <see cref="FlexibleSettingsProvider.DirectoryNameFlags"/>.
  484.     ''' </summary>
  485.     ''' 
  486.     ''' <returns>
  487.     ''' A string representing the fully constructed directory name after applying all configured naming rules;
  488.     ''' For example, <b>"My Application"</b>.
  489.     ''' </returns>
  490.     <DebuggerStepThrough>
  491.     Private Shared Function GetEffectiveDirectoryName() As String
  492.  
  493.         Dim appendApplicationName As Boolean =
  494.             FlexibleSettingsProvider.DirectoryNameFlags.HasFlag(SettingsDirectoryNameFlags.ApplicationName)
  495.  
  496.         Dim appendAssemblyName As Boolean =
  497.             FlexibleSettingsProvider.DirectoryNameFlags.HasFlag(SettingsDirectoryNameFlags.AssemblyName)
  498.  
  499.         Dim appendVersion As Boolean =
  500.             FlexibleSettingsProvider.DirectoryNameFlags.HasFlag(SettingsDirectoryNameFlags.Version)
  501.  
  502.         Dim appendHash As Boolean =
  503.             FlexibleSettingsProvider.DirectoryNameFlags.HasFlag(SettingsDirectoryNameFlags.Hash)
  504.  
  505.         Dim appendUserName As Boolean =
  506.             FlexibleSettingsProvider.DirectoryNameFlags.HasFlag(SettingsDirectoryNameFlags.UserName)
  507.  
  508.         Dim name As String = FlexibleSettingsProvider.DirectoryName
  509.  
  510.         Dim sb As New StringBuilder(Math.Max(16, If(String.IsNullOrEmpty(name), 0, name.Length)))
  511.  
  512.         If Not String.IsNullOrWhiteSpace(name) Then
  513.             sb.Append(name)
  514.         End If
  515.  
  516.         If appendApplicationName Then
  517.             Dim applicationName As String = My.Application.Info.ProductName
  518.  
  519.             If Not String.IsNullOrWhiteSpace(applicationName) Then
  520.  
  521.                 sb.Append($"{If(sb.Length <> 0, "_", "")}{applicationName}")
  522.             End If
  523.         End If
  524.  
  525.         If appendAssemblyName Then
  526.             Dim assemblyName As String = My.Application.Info.AssemblyName
  527.  
  528.             If Not String.IsNullOrWhiteSpace(assemblyName) Then
  529.                 sb.Append($"{If(sb.Length <> 0, "_", "")}{assemblyName}")
  530.             End If
  531.         End If
  532.  
  533.         If appendVersion Then
  534.             Dim version As Version = My.Application.Info.Version
  535.  
  536.             If version IsNot Nothing Then
  537.                 sb.Append($"{If(sb.Length <> 0, "_", "")}{version}")
  538.             End If
  539.         End If
  540.  
  541.         If appendHash Then
  542.             ' Derive a deterministic unique ID from the current assembly GUID.
  543.             Dim asm As Assembly = If(Assembly.GetEntryAssembly(), Assembly.GetExecutingAssembly())
  544.             If asm IsNot Nothing Then
  545.                 Dim guidAttr As GuidAttribute = asm.GetCustomAttribute(Of GuidAttribute)()
  546.  
  547.                 Dim guid As Guid =
  548.                     If(guidAttr IsNot Nothing,
  549.                         New Guid(guidAttr.Value),
  550.                         asm.ManifestModule.ModuleVersionId ' Fallback: Use the manifest module for the GUID extraction value.
  551.                     )
  552.  
  553.                 Dim hashSeed As String =
  554.                     If(guid <> Guid.Empty,
  555.                         guid.ToString("N"),
  556.                         GetType(FlexibleSettingsProvider).FullName ' Fallback: Use the current type full name.
  557.                     )
  558.  
  559.                 Using hasher As HashAlgorithm = HashAlgorithm.Create(FlexibleSettingsProvider.HashAlgorithmType.Name)
  560.                     Dim hashLength As Integer = Math.Min(FlexibleSettingsProvider.HashLength, (hasher.HashSize \ 4))
  561.                     Dim hashString As String = FlexibleSettingsProvider.ComputeDeterministicHashOfString(hasher, hashSeed, hashLength)
  562.  
  563.                     sb.Append($"{If(sb.Length <> 0, "_", "")}{hashString}")
  564.                 End Using
  565.             End If
  566.         End If
  567.  
  568.         If appendUserName Then
  569.             Dim userName As String = Environment.UserName
  570.  
  571.             If Not String.IsNullOrWhiteSpace(userName) Then
  572.                 sb.Append($"{If(sb.Length <> 0, "_", "")}{userName}")
  573.             End If
  574.         End If
  575.  
  576.         Return sb.ToString()
  577.     End Function
  578.  
  579.     ''' <summary>
  580.     ''' Resolves and returns the effective file name used for the user settings configuration file.
  581.     ''' </summary>
  582.     ''' 
  583.     ''' <returns>
  584.     ''' A string representing the effective file name; For example, <b>"user.config"</b>.
  585.     ''' </returns>
  586.     <DebuggerStepThrough>
  587.     Private Shared Function GetEffectiveFileName() As String
  588.  
  589.         Return If(Not String.IsNullOrWhiteSpace(FlexibleSettingsProvider.FileName),
  590.                   FlexibleSettingsProvider.FileName,
  591.                   FlexibleSettingsProvider.DefaultFileName)
  592.     End Function
  593.  
  594.     ''' <summary>
  595.     ''' Resolves and returns the effective full path to the user configuration file.
  596.     ''' </summary>
  597.     ''' 
  598.     ''' <returns>
  599.     ''' A string representing the full path to the user configuration file;
  600.     ''' For example, <b>"C:\Users\{USERNAME}\AppData\Local\My Application\user.config"</b>.
  601.     ''' </returns>
  602.     <DebuggerStepThrough>
  603.     Private Shared Function GetEffectiveConfigFilePath() As String
  604.  
  605.         Dim baseDirectoryPath As String = FlexibleSettingsProvider.GetEffectiveBaseDirectoryPath()
  606.         Dim directoryName As String = FlexibleSettingsProvider.GetEffectiveDirectoryName()
  607.         Dim fileName As String = FlexibleSettingsProvider.GetEffectiveFileName()
  608.  
  609.         Return Path.Combine(baseDirectoryPath, directoryName, fileName)
  610.     End Function
  611.  
  612.     ''' <summary>
  613.     ''' Checks whether the application has read and write permissions in the specified directory.
  614.     ''' </summary>
  615.     ''' 
  616.     ''' <param name="directoryPath">
  617.     ''' The directory path to check for read and write access.
  618.     ''' </param>
  619.     ''' 
  620.     ''' <returns>
  621.     ''' <see langword="True"/> if the application has read and write permissions in the directory; 
  622.     ''' otherwise <see langword="False"/>.
  623.     ''' </returns>
  624.     <DebuggerStepThrough>
  625.     Private Shared Function CanReadAndWriteToDirectory(directoryPath As String) As Boolean
  626.  
  627.         If String.IsNullOrWhiteSpace(directoryPath) Then
  628.             Throw New ArgumentNullException(NameOf(directoryPath))
  629.         End If
  630.  
  631.         If Not Directory.Exists(directoryPath) Then
  632.             Throw New DirectoryNotFoundException($"Directory not found: {directoryPath}")
  633.         End If
  634.  
  635.         Try
  636.             Dim directoryInfo As New DirectoryInfo(directoryPath)
  637.             Dim acl As DirectorySecurity = directoryInfo.GetAccessControl()
  638.             Dim rules As AuthorizationRuleCollection =
  639.                 acl.GetAccessRules(includeExplicit:=True, includeInherited:=True, targetType:=GetType(SecurityIdentifier))
  640.  
  641.             Dim identity As WindowsIdentity = WindowsIdentity.GetCurrent()
  642.             If identity Is Nothing Then
  643.                 Return False
  644.             End If
  645.  
  646.             ' Collect SIDs for current user and groups.
  647.             Dim sids As New HashSet(Of SecurityIdentifier)()
  648.             If identity.User IsNot Nothing Then
  649.                 sids.Add(identity.User)
  650.             End If
  651.             For Each grp As IdentityReference In identity.Groups
  652.                 Dim sid As SecurityIdentifier = TryCast(grp, SecurityIdentifier)
  653.                 If sid IsNot Nothing Then
  654.                     sids.Add(sid)
  655.                 End If
  656.             Next
  657.  
  658.             ' Define the specific bits we require for read and write.
  659.             ' Note: We intentionally DO NOT include Delete/DeleteSubdirectoriesAndFiles here,
  660.             ' because a deny on Delete should not block basic read/write operations.
  661.             Dim requiredRead As FileSystemRights = FileSystemRights.ReadData Or FileSystemRights.ListDirectory Or FileSystemRights.Read
  662.             Dim requiredWrite As FileSystemRights = FileSystemRights.WriteData Or FileSystemRights.AppendData Or FileSystemRights.Write
  663.  
  664.             ' Accumulate allow and deny masks for relevant SIDs.
  665.             Dim accumulatedAllow As FileSystemRights = 0
  666.             Dim accumulatedDeny As FileSystemRights = 0
  667.  
  668.             For Each ruleObj As AuthorizationRule In rules
  669.                 Dim rule As FileSystemAccessRule = TryCast(ruleObj, FileSystemAccessRule)
  670.                 If rule Is Nothing Then
  671.                     Continue For
  672.                 End If
  673.  
  674.                 Dim sid As SecurityIdentifier = TryCast(rule.IdentityReference, SecurityIdentifier)
  675.                 If sid Is Nothing OrElse Not sids.Contains(sid) Then
  676.                     Continue For
  677.                 End If
  678.  
  679.                 Dim rights As FileSystemRights = rule.FileSystemRights
  680.  
  681.                 If rule.AccessControlType = AccessControlType.Deny Then
  682.                     accumulatedDeny = accumulatedDeny Or rights
  683.  
  684.                 ElseIf rule.AccessControlType = AccessControlType.Allow Then
  685.                     accumulatedAllow = accumulatedAllow Or rights
  686.  
  687.                 End If
  688.             Next
  689.  
  690.             ' If any required read/write bit is explicitly denied, cannot read/write.
  691.             If (accumulatedDeny And (requiredRead Or requiredWrite)) <> 0 Then
  692.                 Return False
  693.             End If
  694.  
  695.             ' Check that all required read bits are allowed.
  696.             If (accumulatedAllow And requiredRead) <> requiredRead Then
  697.                 Return False
  698.             End If
  699.  
  700.             ' Check that all required write bits are allowed.
  701.             Return (accumulatedAllow And requiredWrite) = requiredWrite
  702.  
  703.         Catch ex As UnauthorizedAccessException
  704.             ' Explicitly cannot access the directory.
  705.             Return False
  706.  
  707.         Catch ex As SecurityException
  708.             ' Security policy prevents access.
  709.             Return False
  710.  
  711.         Catch ex As Exception
  712.             ' Unexpected error.
  713.             Return False
  714.  
  715.         End Try
  716.     End Function
  717.  
  718.     ''' <summary>
  719.     ''' Computes a deterministic hash of the given input string using the specified hash algorithm type.
  720.     ''' </summary>
  721.     ''' 
  722.     ''' <param name="algorithm">
  723.     ''' The hash algorithm instance to use (e.g., <see cref="MD5"/>, <see cref="SHA256"/>).
  724.     ''' </param>
  725.     ''' 
  726.     ''' <param name="value">
  727.     ''' The input string to compute the hash from.
  728.     ''' </param>
  729.     ''' 
  730.     ''' <param name="length">
  731.     ''' The desired total length of the resulting hexadecimal string.
  732.     ''' <para></para>
  733.     ''' If the computed hash is shorter than this length, the result is padded with '0' characters.
  734.     ''' <para></para>
  735.     ''' If the length is not a multiple of two, the final nibble of the next byte is used for the extra character.
  736.     ''' </param>
  737.     ''' 
  738.     ''' <returns>
  739.     ''' A string of exactly <paramref name="length"/> hexadecimal characters representing the hash of the input string.
  740.     ''' <para></para>
  741.     ''' This is deterministic: the same input and algorithm always produce the same output.
  742.     ''' </returns>
  743.     <DebuggerStepThrough>
  744.     Private Shared Function ComputeDeterministicHashOfString(algorithm As HashAlgorithm,
  745.                                                              value As String,
  746.                                                              length As Integer) As String
  747.  
  748.         Dim bytes() As Byte = Encoding.UTF8.GetBytes(value)
  749.         Dim hash() As Byte = algorithm.ComputeHash(bytes)
  750.  
  751.         Dim sb As New StringBuilder(length)
  752.  
  753.         ' Convert full bytes to hex, up to requested length.
  754.         For i As Integer = 0 To Math.Min((length \ 2) - 1, hash.Length - 1)
  755.             sb.Append(hash(i).ToString("X2"))
  756.         Next
  757.  
  758.         ' If length is odd, append the high nibble of the next byte.
  759.         If length Mod 2 = 1 AndAlso hash.Length > (length \ 2) Then
  760.             sb.Append((hash(length \ 2) >> 4).ToString("X"))
  761.         End If
  762.  
  763.         ' Pad with zeros if the hash is shorter than requested length.
  764.         Dim remaining As Integer = length - sb.Length
  765.         If remaining > 0 Then
  766.             sb.Append(New String("0"c, remaining))
  767.         End If
  768.  
  769.         Return sb.ToString()
  770.     End Function
  771.  
  772. #End Region
  773.  
  774. End Class
  775.  
  776. #End Region
  777.  
  778. #Region " Enumerations "
  779.  
  780. ''' <summary>
  781. ''' Specifies flags that allows to automatically append extra information to the 
  782. ''' settings storage folder name specified by <see cref="FlexibleSettingsProvider.DirectoryName"/> property.
  783. ''' </summary>
  784. <Flags>
  785. Public Enum SettingsDirectoryNameFlags
  786.  
  787.     ''' <summary>
  788.     ''' No additional information is appended to the directory name.
  789.     ''' </summary>
  790.     None = 0
  791.  
  792.     ''' <summary>
  793.     ''' Appends the current application name to the directory name.
  794.     ''' </summary>
  795.     ApplicationName = 1 << 0
  796.  
  797.     ''' <summary>
  798.     ''' Appends the current assembly name to the directory name.
  799.     ''' </summary>
  800.     AssemblyName = 1 << 1
  801.  
  802.     ''' <summary>
  803.     ''' Appends the current application version to the directory name.
  804.     ''' </summary>
  805.     Version = 1 << 2
  806.  
  807.     ''' <summary>
  808.     ''' Appends a deterministic hash to the directory name.
  809.     ''' </summary>
  810.     Hash = 1 << 3
  811.  
  812.     ''' <summary>
  813.     ''' Appends the current user name to the directory name.
  814.     ''' </summary>
  815.     UserName = 1 << 4
  816.  
  817. End Enum
  818.  
  819. #End Region

El modo de empleo es muy sencillo.

Por un lado, tenemos el siguiente namespace con código auto-generado por el diseñador de forms, bien, esto NO DEBEMOS TOCARLO PARA NADA:

Código
  1. '------------------------------------------------------------------------------
  2. ' <auto-generated>
  3. '     This code was generated by a tool.
  4. '     Runtime Version:4.0.30319.42000
  5. '
  6. '     Changes to this file may cause incorrect behavior and will be lost if
  7. '     the code is regenerated.
  8. ' </auto-generated>
  9. '------------------------------------------------------------------------------
  10. Namespace My
  11.  
  12.     <Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(),  _
  13.      Global.System.CodeDom.Compiler.GeneratedCodeAttribute("Microsoft.VisualStudio.Editors.SettingsDesigner.SettingsSingleFileGenerator", "17.14.0.0"),  _
  14.      Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)>  _
  15.     Partial Friend NotInheritable Class MySettings
  16.         Inherits Global.System.Configuration.ApplicationSettingsBase
  17.  
  18.         ' ...
  19.     End Class
  20. End Namespace

En lugar de eso, simplemente añadiremos el siguiente código en cualquier otra parte de nuestro código fuente, estableciendo la clase de atributo SettingsProvider para asignar nuestro proveedor de configuración, y aplicando el valor que queramos para las propiedades del proveedor:

Código
  1. Namespace My
  2.  
  3.     <Global.System.Configuration.SettingsProvider(GetType(FlexibleSettingsProvider))>
  4.     Partial Friend NotInheritable Class MySettings
  5.  
  6.         Public Sub New()
  7.             FlexibleSettingsProvider.BaseDirectoryPath = ".\"
  8.             FlexibleSettingsProvider.DirectoryName = Nothing
  9.             FlexibleSettingsProvider.DirectoryNameFlags = SettingsDirectoryNameFlags.None
  10.             FlexibleSettingsProvider.FileName = "user.config"
  11.  
  12.             Debug.WriteLine($"Effective config file path: {FlexibleSettingsProvider.EffectiveConfigFilePath}")
  13.         End Sub
  14.  
  15.     End Class
  16. End Namespace

Con este esjemplo en específico, el archivo "user.config" se guardará en el directorio base de nuestra aplicación.


En c#, podemos replicar el mismo procedimiento, pero con la clase Settings como en el siguiente ejemplo:

Código
  1. namespace WindowsFormsApp1.Properties
  2. {
  3.     [SettingsProvider(typeof(FlexibleSettingsProvider))]
  4.     internal sealed partial class Settings : global::System.Configuration.ApplicationSettingsBase
  5.     {
  6.         public Settings()
  7.         {
  8.             FlexibleSettingsProvider.BaseDirectoryPath = @".\";
  9.             FlexibleSettingsProvider.DirectoryName = null;
  10.             FlexibleSettingsProvider.DirectoryNameFlags = SettingsDirectoryNameFlags.None;
  11.             FlexibleSettingsProvider.FileName = "user.config";
  12.  
  13.             Debug.WriteLine($"Effective config file path: {FlexibleSettingsProvider.EffectiveConfigFilePath}");
  14.         }
  15.     }
  16. }

Por si todavía no ha quedado claro, sí, este código hace magía, tan solo necesitamos configurar la ruta del directorio y el nombre del archivo, y todo lo demás funcionará exactamente igual (o casi, casi igual) que como si estuvieramos dejando que la infraestructura de Microsoft gestione el directorio y el archivo de configuración para leer y escribir en él, pero evitando que se generen mil y una carpetas tras cada pequeña actualización de nuestra aplicación.
« Última modificación: Ayer a las 00:37 por Eleкtro » En línea


Páginas: 1 ... 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 [62] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Librería de Snippets en C/C++ « 1 2 3 4 »
Programación C/C++ 		z3nth10n 31 30,722 Último mensaje 2 Agosto 2013, 17:13 pm
por 0xDani
[APORTE] [VBS] Snippets para manipular reglas de bloqueo del firewall de Windows
Scripting 		Eleкtro 1 5,363 Último mensaje 3 Febrero 2014, 20:19 pm
por Eleкtro
Librería de Snippets para Delphi « 1 2 »
Programación General 		crack81 15 27,623 Último mensaje 25 Marzo 2016, 18:39 pm
por crack81
Una organización en Github para subir, proyectos, snippets y otros?
Sugerencias y dudas sobre el Foro 		z3nth10n 0 4,247 Último mensaje 21 Febrero 2017, 10:47 am
por z3nth10n
índice de la Librería de Snippets para VB.NET !!
.NET (C#, VB.NET, ASP) 		Eleкtro 7 8,632 Último mensaje 4 Julio 2018, 21:35 pm
por Eleкtro
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines