Login Register






[Collection] Source Codes VB6 filter_list
Author
Message
[Collection] Source Codes VB6 #1
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

Reply