Cambia el theme actual de Windows
Os aconsejo cambiar el theme de esta manera en lugar de usar la función
SetWindowTheme porque dicha función no cambia el theme corréctamente (no cambia los colores personalizados).
#Region " Set Aero Theme "
' [ Set Aero Theme Function ]
'
' // By Elektro H@cker
'
' Instructions :
' Add a reference for "System.ServiceProcess"
'
' Set_Aero_Theme("C:\Windows\Resources\Themes\aero\aero.msstyles")
' Set_Aero_Theme("C:\Windows\Resources\Themes\Concave 7\Concave 7.msstyles")
' Set_Aero_Theme("C:\Windows\Resources\Themes\Aero\Luna.msstyles", "Metallic", "NormalSize")
Private Function Set_Aero_Theme(ByVal ThemeFile As String, _
Optional ByVal ColorName As String = "NormalColor", _
Optional ByVal SizeName As String = "NormalSize" _
) As Boolean
Try
Using ThemeService As New ServiceProcess.ServiceController("Themes")
ThemeService.Stop()
ThemeService.WaitForStatus(1) ' Wait for Stopped
My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\ThemeManager", "LoadedBefore", "0", Microsoft.Win32.RegistryValueKind.String)
My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\ThemeManager", "DllName", ThemeFile, Microsoft.Win32.RegistryValueKind.String)
My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\ThemeManager", "ColorName", ColorName, Microsoft.Win32.RegistryValueKind.String)
My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\ThemeManager", "SizeName", SizeName, Microsoft.Win32.RegistryValueKind.String)
ThemeService.Start()
ThemeService.WaitForStatus(4) ' Wait for Running
End Using
Catch ex As Exception
'MsgBox(ex.message)
Return False
End Try
Return True
End Function
#End Region
Devuelve información del theme actual
PD: Yo solo he creado la función.
#Region " Get Current Aero Theme "
' [ Get Current Aero Theme Function ]
'
' // By Elektro H@cker
'
' Examples:
' MsgBox(Get_Current_Aero_Theme(Theme_Info.Name))
' MsgBox(Get_Current_Aero_Theme(Theme_Info.FullPath))
Public Structure ThemeInfo
Private Declare Unicode Function GetCurrentThemeName _
Lib "uxtheme.dll" _
( _
ByVal pszThemeFileName As String, _
ByVal dwMaxNameChars As Int32, _
ByVal pszColorBuff As String, _
ByVal cchMaxColorChars As Int32, _
ByVal pszSizeBuff As String, _
ByVal cchMaxSizeChars As Int32 _
) As Int32
Private Const S_OK As Int32 = &H0
Private m_FileName As String
Private m_ColorSchemeName As String
Private m_SizeName As String
Public Property FileName() As String
Get
Return m_FileName
End Get
Set(ByVal Value As String)
m_FileName = Value
End Set
End Property
Public Property ColorSchemeName() As String
Get
Return m_ColorSchemeName
End Get
Set(ByVal Value As String)
m_ColorSchemeName = Value
End Set
End Property
Public Property SizeName() As String
Get
Return m_SizeName
End Get
Set(ByVal Value As String)
m_SizeName = Value
End Set
End Property
Public Overrides Function ToString() As String
Return _
"FileName={" & Me.FileName & _
"} ColorSchemeName={" & Me.ColorSchemeName & _
"} SizeName={" & Me.SizeName & "}"
End Function
Public Shared ReadOnly Property CurrentTheme() As ThemeInfo
Get
Dim ti As New ThemeInfo()
Const BufferLength As Int32 = 256
ti.FileName = Strings.Space(BufferLength)
ti.ColorSchemeName = ti.FileName
ti.SizeName = ti.FileName
If _
GetCurrentThemeName( _
ti.FileName, _
BufferLength, _
ti.ColorSchemeName, _
BufferLength, _
ti.SizeName, _
BufferLength _
) = S_OK _
Then
ti.FileName = NullTrim(ti.FileName)
ti.ColorSchemeName = NullTrim(ti.ColorSchemeName)
ti.SizeName = NullTrim(ti.SizeName)
Return ti
Else
Const Message As String = _
"An error occured when attempting to get theme info."
Throw New Exception(Message)
End If
End Get
End Property
Private Shared Function NullTrim(ByVal Text As String) As String
Return _
Strings.Left( _
Text, _
Strings.InStr(Text, ControlChars.NullChar) - 1 _
)
End Function
End Structure
Public Enum Theme_Info
Name
FileName
FullPath
ColorScheme
Size
End Enum
Private Function Get_Current_Aero_Theme(ByVal Info As Theme_Info) As String
Select Case Info
Case Theme_Info.Name : Return ThemeInfo.CurrentTheme.FileName.Split("\").Last.Split(".").First
Case Theme_Info.FileName : Return ThemeInfo.CurrentTheme.FileName.Split("\").Last
Case Theme_Info.FullPath : Return ThemeInfo.CurrentTheme.FileName
Case Theme_Info.ColorScheme : Return ThemeInfo.CurrentTheme.ColorSchemeName
Case Theme_Info.Size : Return ThemeInfo.CurrentTheme.SizeName
Case Else : Return Nothing
End Select
End Function
#End Region
Escribe texto a la CMD desde un proyecto Windowsforms
Declare Function AttachConsole Lib "kernel32.dll" (ByVal dwProcessId As Int32) As Boolean
Declare Function FreeConsole Lib "kernel32.dll" () As Boolean
AttachConsole(-1) ' Attach the console
System.Console.Writeline("I am writing from a WinForm to the console!")
FreeConsole() ' Desattach the console
Adjunta una nueva instancia de la CMD a la aplicación.
Public Declare Function AllocConsole Lib "kernel32.dll" () As Boolean
AllocConsole()
Console.WriteLine("this is my console!") : Threading.Thread.Sleep(5000)
Detecta si la aplicación se ejecutó desde la consola
Un ejemplo de uso? Pues por ejemplo el que yo le doy, si el usuario ejecuta la aplicación desde la consola entonces muestro una ayuda sobre la sintaxis y etc en la consola, de lo contrario obviamente no muestro nada.
#Region " App Is Launched From CMD? "
' [ App Is Launched From CMD? Function ]
'
' // By Elektro H@cker
'
' Examples:
' MsgBox(App_Is_Launched_From_CMD)
' If App_Is_Launched_From_CMD() Then Console.WriteLine("Help for this application: ...")
Declare Function AttachConsole Lib "kernel32.dll" (ByVal dwProcessId As Int32) As Boolean
Declare Function FreeConsole Lib "kernel32.dll" () As Boolean
Private Function App_Is_Launched_From_CMD() As Boolean
If AttachConsole(-1) Then
FreeConsole()
Return True
Else
Return False
End If
End Function
#End Region
Parte un archivo de texto en trozos especificando el tamaño.
PD: El code no es de mi propiedad pero lo he sacado de un código de C# y lo he retocado casi por completo para hacerlo más funcional, así que me doy los créditos.
#Region " Split File "
' [ Split File Function ]
'
' // By Elektro H@cker
'
' Examples :
' MsgBox(Split_File("C:\Test.txt", 10000, , True))
' MsgBox(Split_File("C:\Test.txt", 10000, "Splitted"))
Public Function Split_File
(ByVal File As String, _
ByVal ChunkSize As Long, _
Optional ByVal OutputName As String = Nothing, _
Optional ByVal Preserve_FileExtension As Boolean = True _
) As Boolean
Dim Index As Long
Dim OutputFile As String
Dim BaseName As String
Dim StartPosition As Long
Dim Buffer As Byte() = New Byte() {}
Dim InputFileStram As System.IO.FileStream
Dim OutputFileStram As System.IO.FileStream
Dim BinaryWriter As IO.BinaryWriter
Dim BinaryReader As IO.BinaryReader
Dim Fragments As Long
Dim RemainingBytes As Long
Dim Progress As Double
Dim Zeroes As String = ""
Try
Dim FileInfo
As New IO.
FileInfo(File) Dim Filename As String = FileInfo.FullName
Dim FileExtension As String = FileInfo.Extension
Dim outputpath As String = FileInfo.DirectoryName
Dim FileSize As Long = FileInfo.Length
If OutputName IsNot Nothing Then : BaseName = OutputName
Else : BaseName = FileInfo.Name.Replace(FileInfo.Extension, "") : End If
If Not IO.
File.
Exists(Filename
) Then MsgBox("File " & Filename & " doesn't exist")
Return False
End If
If FileSize <= ChunkSize Then
MsgBox(Filename & " size(" & FileSize & ") is less than the ChunkSize(" & ChunkSize & ")")
Return False
End If
InputFileStram = New IO.FileStream(Filename, IO.FileMode.Open)
BinaryReader = New IO.BinaryReader(InputFileStram)
Fragments = Math.Floor(FileSize / ChunkSize)
For n As Integer = 1 To Fragments.ToString.Length : Zeroes += "0" : Next
Progress = 100 / Fragments
RemainingBytes = FileSize - (Fragments * ChunkSize)
If outputpath = "" Then outputpath = IO.Directory.GetParent(Filename).ToString
If Not IO.Directory.Exists(outputpath) Then IO.Directory.CreateDirectory(outputpath)
BinaryReader.BaseStream.Seek(0, IO.SeekOrigin.Begin)
For Index = 1 To Fragments
If Preserve_FileExtension Then : OutputFile = outputpath & "\" & BaseName & "." & Format(Index, Zeroes) & FileExtension
Else : OutputFile = outputpath & "\" & BaseName & "." & Format(Index, Zeroes)
End If
ReDim Buffer(ChunkSize - 1)
BinaryReader.Read(Buffer, 0, ChunkSize)
StartPosition = BinaryReader.BaseStream.Seek(0, IO.SeekOrigin.Current)
If IO.
File.
Exists(OutputFile
) Then IO.
File.
Delete(OutputFile
) OutputFileStram = New System.IO.FileStream(OutputFile, IO.FileMode.Create)
BinaryWriter = New IO.BinaryWriter(OutputFileStram)
BinaryWriter.Write(Buffer)
OutputFileStram.Flush()
BinaryWriter.Close()
OutputFileStram.Close()
Next
If RemainingBytes > 0 Then
If Preserve_FileExtension Then : OutputFile = outputpath & "\" & BaseName & "." & Format(Index, Zeroes) & FileExtension
Else : OutputFile = outputpath & "\" & BaseName & "." & Format(Index, Zeroes)
End If
ReDim Buffer(RemainingBytes - 1)
BinaryReader.Read(Buffer, 0, RemainingBytes)
If IO.
File.
Exists(OutputFile
) Then IO.
File.
Delete(OutputFile
) OutputFileStram = New System.IO.FileStream(OutputFile, IO.FileMode.Create)
BinaryWriter = New IO.BinaryWriter(OutputFileStram)
BinaryWriter.Write(Buffer)
OutputFileStram.Flush()
BinaryWriter.Close()
OutputFileStram.Close()
End If
InputFileStram.Close()
BinaryReader.Close()
Return True
Catch ex As Exception
MsgBox(ex.Message)
Return False
Finally
BinaryWriter = Nothing
OutputFileStram = Nothing
BinaryReader = Nothing
InputFileStram = Nothing
End Try
End Function
#End Region
Parte un archivo de texto en trozos especificando el número de líneas por archivo.
#Region " Split TextFile By Number Of Lines "
' [ Split TextFile By Number Of Lines Function ]
'
' // By Elektro H@cker
'
' Examples :
' Split_TextFile_By_Number_Of_Lines("C:\Test.txt", 10000)
' MsgBox(Split_TextFile_By_Number_Of_Lines("C:\Test.txt", 10))
Private Function Split_TextFile_By_Number_Of_Lines(ByVal TextFile As String, ByVal NumberOfLines As Long) As Boolean
Try
Dim FileInfo As New IO.FileInfo(TextFile)
If NumberOfLines > IO.
File.
ReadAllLines(TextFile
).
Length Then ' MsgBox("Number of lines is greater than total file lines")
Return False
End If
Using sr As New System.IO.StreamReader(TextFile)
Dim fileNumber As Integer = 0
While Not sr.EndOfStream
Dim count As Integer = 0
Using sw As New System.IO.StreamWriter(FileInfo.DirectoryName & "\" & FileInfo.Name.Replace(FileInfo.Extension, " " & System.Threading.Interlocked.Increment(fileNumber) & FileInfo.Extension))
sw.AutoFlush = True
While Not sr.EndOfStream AndAlso Not System.Threading.Interlocked.Increment(count) > NumberOfLines
Application.DoEvents()
sw.WriteLine(sr.ReadLine())
End While
End Using
End While
End Using
Return True
Catch ex As Exception
Throw New Exception(ex.Message)
End Try
End Function
#End Region