[Collection] Source Codes VB6 - Printable Version

[Collection] Source Codes VB6 - Printable Version

+- Sinisterly (https://sinister.li)
+-- Forum: Coding (https://sinister.li/Forum-Coding)
+--- Forum: Visual Basic & .NET Framework (https://sinister.li/Forum-Visual-Basic-NET-Framework)
+--- Thread: [Collection] Source Codes VB6 (/Thread-Collection-Source-Codes-VB6)

[Collection] Source Codes VB6 - Kaveman - 09-18-2011

Use API To See If Windows Started In Safe Mode

Code:
Declare Function GetSystemMetrics Lib "user32" _
        (ByVal nIndex As Long) As Long
Public Const SM_CLEANBOOT = 67

No go to your main form, add a command button, double click on the button to go to its click event handler, and add the following code.
Select Case GetSystemMetrics(SM_CLEANBOOT)
    Case 1: MsgBox "Windows was Started in Safe Mode."
    Case 2: MsgBox _
                "Windows was Started in Safe Mode with Network support."
    Case Else: MsgBox "Windows is running normally."
End Select

Create PDF in VB Source Code
Drag and Drop With List Box

Code:
Dim ItemCount As Integer
Dim I As Integer
 
On Error Resume Next
ItemCount = Data.Files.Count
 
For I = 1 To ItemCount
    List1.AddItem Data.Files(I)
Next
 
If Err Then Err.Clear

Simple way to store strings in the Registry

Code:
Private Sub Command1_Click()
        SaveSetting "MyString", "New", "Test", Text1.Text
End Sub
 
Private Sub Command2_Click()
        Text2.Text = GetSetting("MyString", "New", _
                "Test", vbNullString)
End Sub
 
Private Sub Form_Load()
        Text1.Text = "This is a Test"
        Command1.Caption = "Write Value"
        Command2.Caption = "Read Value"
End Sub

Convert HTML Color to RGB

Code:
Function HTMLtoRGB(HtmlCode As String) As String
        If Left(HtmlCode, 1) = "#" Then 
                HtmlCode = Right(HtmlCode, 6)
        End If
 
        RED = Left(HtmlCode, 2)
        GREEN = Mid(HtmlCode, 3, 2)
        BLUE = Right(HtmlCode, 2)
        RgbHex = "&H00" + BLUE + GREEN + RED
        HTMLtoRGB = "&" & Val(RgbHex)
End Function
 
Private Sub Command1_Click()
    MsgBox HTMLtoRGB("0000FF")
End Sub

Fancy Collapsing Form Exit

Code:
Do While Me.Width > 1800
        Me.Width = Me.Width - 300
        Me.Left = Me.Left + 150
        If Me.Height - 400 Then
                Me.Top = Me.Top - 1
                Me.Height = Me.Height - 150
        End If
Loop
Unload Form1: End

Replace Text in a TextBox

Code:
Dim StartPos, Counter As Integer
Dim FindString, ReplaceText As String
FindString = "test"
ReplaceText = "MyString"
 
For Counter = 1 To Len(Text1.Text)
        StartPos = InStr(Text1.Text, FindString)
        If StartPos > 0 Then
                Text1.SelStart = StartPos - 1
                Text1.SelLength = Len(FindString)
                Text1.SelText = "" + ReplaceText
        End If
Next

Count the number of words in a textbox

Code:
Dim Counter As Integer
Dim StartPos As Integer
 
If Trim(Text1) = "" Then
    NumOfWords = 0
    Exit Sub
End If
 
Text1 = Trim(Text1) ' Remove All Spaces
 
While InStr(1, Text1, " ") > 0 'Remove Double Spaces
    StartPos = InStr(1, Text1, " ")
    Text1 = Mid(Text1, 1, StartPos - 1) & _
                Mid(Text1, StartPos + 1, Len(Text1) - StartPos)
Wend
 
NumOfWords = 1
For Counter = 1 To Len(Text1)
        If Mid(Text1, Counter, 1) = " " Then 
                NumOfWords = NumOfWords + 1
        End If
Next Counter
 
MsgBox "Found " & NumOfWords & " Words"

Remove an element from an array

Code:
Private Type my_type
    field1 As String
    field2 As Long
    field3 As Integer
End Type
 
Const MAX_ARRAY = 10
 
Dim strBuffer(0 To MAX_ARRAY - 1) As my_type
 
Public Sub DeleteRecordFromMyArray(RecPos As Integer, MaxRecs As Integer)
        Dim I As Integer
 
        For I = RecPos To MaxRecs - 1
                strBuffer(I) = strBuffer(I + 1)
        Next
 
        strBuffer(MaxRecs).field1 = ""
        strBuffer(MaxRecs).field2 = 0
        strBuffer(MaxRecs).field3 = 0
End Sub

Launch a program from VB

Code:
Dim Res
Dim Filename
    Filename = "C:\windows\notepad.exe" 'Check file is here first
If Dir(Filename) = "" Then
    MsgBox Filename & " not found", vbInformation
Else
    Res = Shell("Start.exe " & Filename, vbHide)
End If

Copy a File Quickly

Code:
Dim mByte() As Byte
 
Open "C:\Command.com" For Binary As #1
Open "C:\Backup.com" For Binary As #2
 
ReDim mByte(0 To LOF(1))
 
Get #1, , mByte()
Put #2, , mByte()
 
Close #1
Close #2
 
MsgBox "Done", vbInformation