Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing Form1.frm (23.25 KB)
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Mini Functions By Jason's PC v2.5.2"
ClientHeight = 7335
ClientLeft = 45
ClientTop = 330
ClientWidth = 5415
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 7335
ScaleWidth = 5415
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton Command5
Caption = "&Text File Tools..."
Height = 375
Left = 120
TabIndex = 19
Top = 6840
Width = 1575
End
Begin VB.Frame Frame6
Caption = "Conversion: Hexadecimal / Decimal / Binary / Character"
Height = 2415
Left = 120
TabIndex = 32
Top = 4320
Width = 5175
Begin VB.TextBox Text15
Height = 975
Left = 480
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 17
Top = 1320
Width = 2055
End
Begin VB.TextBox Text14
Height = 975
Left = 3000
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 18
Top = 1320
Width = 2055
End
Begin VB.TextBox Text13
Height = 975
Left = 480
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 15
Top = 240
Width = 2055
End
Begin VB.TextBox Text12
Height = 975
Left = 3000
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 16
Top = 240
Width = 2055
End
Begin VB.Label Label10
Caption = "B i n"
Height = 615
Left = 240
TabIndex = 36
Top = 1560
Width = 135
End
Begin VB.Label Label9
Caption = "C h a r"
Height = 735
Left = 2760
TabIndex = 35
Top = 1440
Width = 135
End
Begin VB.Label Label8
Caption = "D e c"
Height = 615
Left = 2760
TabIndex = 34
Top = 480
Width = 135
End
Begin VB.Label Label7
Caption = "H e x"
Height = 615
Left = 240
TabIndex = 33
Top = 480
Width = 135
End
End
Begin VB.CommandButton Command4
Caption = "&Picture Fader..."
Height = 375
Left = 3720
TabIndex = 20
Top = 6840
Width = 1575
End
Begin VB.Frame Frame5
Caption = "RGB Function"
Height = 2175
Left = 2640
TabIndex = 26
Top = 2040
Width = 2655
Begin VB.CommandButton Command2
Caption = "&Fader..."
Height = 285
Left = 240
TabIndex = 13
Top = 1680
Width = 855
End
Begin VB.CommandButton Command3
Caption = "&Random"
Height = 285
Left = 1560
TabIndex = 14
Top = 1680
Width = 855
End
Begin VB.TextBox Text9
Alignment = 2 'Center
Height = 285
Left = 1770
MaxLength = 5
TabIndex = 12
Text = "0"
Top = 600
Width = 615
End
Begin VB.TextBox Text8
Alignment = 2 'Center
Height = 285
Left = 1000
MaxLength = 5
TabIndex = 11
Text = "0"
Top = 600
Width = 615
End
Begin VB.TextBox Text7
Alignment = 2 'Center
Height = 285
Left = 240
MaxLength = 5
TabIndex = 10
Text = "0"
Top = 600
Width = 615
End
Begin VB.Label Label4
Alignment = 2 'Center
Caption = "Blue"
Height = 255
Left = 1770
TabIndex = 29
Top = 360
Width = 615
End
Begin VB.Label Label2
Alignment = 2 'Center
Caption = "Green"
Height = 255
Left = 1000
TabIndex = 28
Top = 360
Width = 615
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "Red"
Height = 255
Left = 240
TabIndex = 27
Top = 360
Width = 615
End
Begin VB.Shape Shape1
FillStyle = 0 'Solid
Height = 615
Left = 240
Top = 960
Width = 2175
End
End
Begin VB.Frame Frame4
Caption = "ASCII Character Set 0 - 255"
Height = 2175
Left = 120
TabIndex = 25
Top = 2040
Width = 2415
Begin VB.TextBox Text11
Alignment = 2 'Center
Height = 285
Left = 1920
MaxLength = 3
TabIndex = 9
Text = "255"
Top = 1800
Width = 375
End
Begin VB.TextBox Text10
Alignment = 2 'Center
Height = 285
Left = 720
MaxLength = 3
TabIndex = 8
Text = "0"
Top = 1800
Width = 375
End
Begin ComctlLib.ListView ListView1
Height = 1455
Left = 120
TabIndex = 7
Top = 240
Width = 2175
_ExtentX = 3836
_ExtentY = 2566
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 327682
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 2
BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
Key = ""
Object.Tag = ""
Text = "Code"
Object.Width = 725
EndProperty
BeginProperty ColumnHeader(2) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
SubItemIndex = 1
Key = ""
Object.Tag = ""
Text = "Character"
Object.Width = 1588
EndProperty
End
Begin VB.Label Label6
Caption = "To #:"
Height = 255
Left = 1440
TabIndex = 31
Top = 1830
Width = 495
End
Begin VB.Label Label5
Caption = "From #:"
Height = 255
Left = 120
TabIndex = 30
Top = 1830
Width = 615
End
End
Begin VB.Frame Frame3
Caption = "Error Description"
Height = 1815
Left = 2640
TabIndex = 23
Top = 120
Width = 2655
Begin VB.CommandButton Command1
Caption = "&Copy"
Height = 285
Left = 1800
TabIndex = 6
Top = 1320
Width = 615
End
Begin VB.TextBox Text4
Height = 855
Left = 240
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 5
Text = "Form1.frx":0442
Top = 360
Width = 2175
End
Begin VB.TextBox Text3
Alignment = 2 'Center
Height = 285
Left = 1080
MaxLength = 5
TabIndex = 4
Text = "0"
Top = 1320
Width = 615
End
Begin VB.Label Label3
Caption = "Error Code:"
Height = 255
Left = 240
TabIndex = 24
Top = 1350
Width = 855
End
End
Begin VB.Frame Frame2
Caption = "ASCII Character (0 - 255)"
Height = 855
Left = 120
TabIndex = 22
Top = 1080
Width = 2415
Begin VB.TextBox Text6
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 285
Left = 600
Locked = -1 'True
TabIndex = 3
Text = "Character: (null)"
Top = 390
Width = 1575
End
Begin VB.TextBox Text2
Alignment = 2 'Center
Height = 285
Left = 120
MaxLength = 3
TabIndex = 2
Text = "0"
Top = 360
Width = 375
End
End
Begin VB.Frame Frame1
Caption = "ASCII Code (0 - 255)"
Height = 855
Left = 120
TabIndex = 21
Top = 120
Width = 2415
Begin VB.TextBox Text5
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 285
Left = 600
Locked = -1 'True
TabIndex = 1
Text = "Character Code: 0"
Top = 390
Width = 1575
End
Begin VB.TextBox Text1
Alignment = 2 'Center
Height = 285
Left = 120
MaxLength = 1
TabIndex = 0
Top = 360
Width = 375
End
End
Begin VB.Menu CopyPopup
Caption = "Copy Popup"
Visible = 0 'False
Begin VB.Menu CopyCode
Caption = "Copy &Code to Clipboard"
End
Begin VB.Menu CopyChar
Caption = "Copy C&haracter to Clipboard"
End
Begin VB.Menu CopyBoth
Caption = "Copy &Both to Clipboard"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Ex()
Dim Cl
Dim NoCalc As Boolean
Public Function Dec2Bin(ByVal nDec As Integer) As String
Dim i As Integer
Dim j As Integer
Dim sHex As String
Const HexChar As String = "0123456789ABCDEF"
sHex = Hex(nDec)
For i = 1 To Len(sHex)
nDec = InStr(1, HexChar, Mid(sHex, i, 1)) - 1
For j = 3 To 0 Step -1
Dec2Bin = Dec2Bin & nDec \ 2 ^ j
nDec = nDec Mod 2 ^ j
Next j
Next i
i = InStr(1, Dec2Bin, "1")
If i <> 0 Then Dec2Bin = Mid(Dec2Bin, i)
End Function
Public Function Bin2Dec(ByVal sBin As String) As Long
Dim i As Integer
For i = 1 To Len(sBin)
Bin2Dec = Bin2Dec + CLng(CInt(Mid(sBin, Len(sBin) - i + 1, 1)) * 2 ^ (i - 1))
Next i
End Function
Public Function Hex2Dec(ByVal sHex As String) As Long
Dim i As Integer
Dim nDec As Long
Const HexChar As String = "0123456789ABCDEF"
For i = Len(sHex) To 1 Step -1
nDec = nDec + (InStr(1, HexChar, Mid(sHex, i, 1)) - 1) * 16 ^ (Len(sHex) - i)
Next i
Hex2Dec = CStr(nDec)
End Function
Function GetDecimal(HexStr As Long) As Long
GetDecimal = HexStr
End Function
Private Sub Command1_Click()
On Error GoTo ClpErr
C = Text4.SelText
If C = "" Then C = Text4.Text
Clipboard.SetText C
Exit Sub
ClpErr:
MsgBox "Unexpected Error " & Err, vbOKOnly + vbCritical, "Error"
End
End Sub
Private Sub Command2_Click()
Form2.Show 0, Me
End Sub
Private Sub Command3_Click()
Randomize Timer
Text7.Text = Int(Rnd * 256)
Text8.Text = Int(Rnd * 256)
Text9.Text = Int(Rnd * 256)
End Sub
Private Sub Command4_Click()
Form4.Show 1
End Sub
Private Sub Command5_Click()
Form5.Show 1
End Sub
Private Sub CopyBoth_Click()
On Error GoTo ClpErr
Clipboard.SetText ListView1.SelectedItem + " " + ListView1.ListItems.Item(ListView1.SelectedItem.Index).SubItems(1)
Exit Sub
ClpErr:
M = MsgBox("Unexpected Error" + Str(Err.Number), vbOKOnly + vbCritical, "Error")
End
End Sub
Private Sub CopyChar_Click()
On Error GoTo ClpErr
Clipboard.SetText ListView1.ListItems.Item(ListView1.SelectedItem.Index).SubItems(1)
Exit Sub
ClpErr:
M = MsgBox("Unexpected Error" + Str(Err.Number), vbOKOnly + vbCritical, "Error")
End
End Sub
Private Sub CopyCode_Click()
On Error GoTo ClpErr
Clipboard.SetText ListView1.SelectedItem
Exit Sub
ClpErr:
M = MsgBox("Unexpected Error" + Str(Err.Number), vbOKOnly + vbCritical, "Error")
End
End Sub
Private Sub Form_Load()
ReDim Ex(0 To 255)
Ex(0) = "(null)"
Ex(8) = "(backspace)"
Ex(9) = "(tab)"
Ex(10) = "(lf)"
Ex(13) = "(cr/enter)"
Ex(27) = "(esc)"
Ex(32) = "(space)"
Ex(160) = "(space)"
For i = 0 To 255
Set LI = ListView1.ListItems.Add()
LI.Text = Trim(Str(i))
If Ex(i) = "" Then Ex(i) = Chr(i)
LI.SubItems(1) = Ex(i)
Next i
Dim rStyle As Long
Dim rStyle2 As Long
rStyle = SendMessageLong(ListView1.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
rStyle = rStyle Xor LVS_EX_FULLROWSELECT
rStyle2 = SendMessageLong(ListView1.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, rStyle)
NoCalc = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub ListView1_Click()
Cl = True
End Sub
Private Sub ListView1_LostFocus()
Cl = False
End Sub
Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 2 Or Cl = False Then Exit Sub
PopupMenu CopyPopup
End Sub
Private Sub Text1_Change()
On Error GoTo ChrErr
If Text1.Text = "" Then Text5.Text = "Character Code: 0"
If Text1.Text <> "" Then Text5.Text = "Character Code:" + Str$(Asc(Text1.Text))
Exit Sub
ChrErr:
Text5.Text = "Error" + Str$(Err.Number)
End Sub
Private Sub Text10_Change()
If Val(Text10.Text) > 255 Then Text10.Text = "255": Text10.SelStart = Len(Text10.Text)
If Val(Text10.Text) > Val(Text11.Text) Then Exit Sub
ListView1.MousePointer = 11
Text10.MousePointer = 11
Text11.MousePointer = 11
Frame4.Caption = "ASCII Character Set " + Text10.Text + " - " + Text11.Text
ListView1.ListItems.Clear
For i = Val(Text10.Text) To Val(Text11.Text)
Set LI = ListView1.ListItems.Add()
LI.Text = Trim(Str(i))
If Ex(i) = "" Then Ex(i) = Chr(i)
LI.SubItems(1) = Ex(i)
Next i
ListView1.MousePointer = 0
Text10.MousePointer = 0
Text11.MousePointer = 0
End Sub
Private Sub Text10_GotFocus()
Text10.SelStart = 0
Text10.SelLength = Len(Text10.Text)
End Sub
Private Sub Text10_KeyPress(KeyAscii As Integer)
If KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 8 Then Exit Sub
KeyAscii = 0
End Sub
Private Sub Text10_LostFocus()
Text10.Text = Val(Text10.Text)
End Sub
Private Sub Text11_Change()
If Val(Text11.Text) > 255 Then Text11.Text = "255": Text11.SelStart = Len(Text11.Text)
If Val(Text10.Text) > Val(Text11.Text) Then Exit Sub
ListView1.MousePointer = 11
Text10.MousePointer = 11
Text11.MousePointer = 11
Frame4.Caption = "ASCII Character Set " + Text10.Text + " - " + Text11.Text
ListView1.ListItems.Clear
For i = Val(Text10.Text) To Val(Text11.Text)
Set LI = ListView1.ListItems.Add()
LI.Text = Trim(Str(i))
If Ex(i) = "" Then Ex(i) = Chr(i)
LI.SubItems(1) = Ex(i)
Next i
ListView1.MousePointer = 0
Text10.MousePointer = 0
Text11.MousePointer = 0
End Sub
Private Sub Text11_GotFocus()
Text11.SelStart = 0
Text11.SelLength = Len(Text11.Text)
End Sub
Private Sub Text11_KeyPress(KeyAscii As Integer)
If KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 8 Then Exit Sub
KeyAscii = 0
End Sub
Private Sub Text11_LostFocus()
Text11.Text = Val(Text11.Text)
End Sub
Private Sub Text12_Change()
On Error Resume Next
Dim StrArray() As String
Dim i As Integer
If NoCalc Then Exit Sub
NoCalc = True
StrArray = Split(Text12.Text, " ")
Text13.Text = ""
Text14.Text = ""
Text15.Text = ""
For i = 0 To UBound(StrArray)
Text13.Text = Text13.Text & Hex(Val(StrArray(i))) & " "
Text14.Text = Text14.Text & IIf(Val(StrArray(i)) >= 0 And _
Val(StrArray(i)) < 256, Chr(Val(StrArray(i))), "")
Text15.Text = Text15.Text & Dec2Bin(Val(StrArray(i))) & " "
Next i
NoCalc = False
End Sub
Private Sub Text13_Change()
On Error Resume Next
Dim StrArray() As String
Dim i As Integer
If NoCalc Then Exit Sub
NoCalc = True
StrArray = Split(Text13.Text, " ")
Text12.Text = ""
Text14.Text = ""
Text15.Text = ""
For i = 0 To UBound(StrArray)
Text12.Text = Text12.Text & Hex2Dec(StrArray(i)) & " "
Text14.Text = Text14.Text & IIf(Hex2Dec(StrArray(i)) >= 0 And _
Hex2Dec(StrArray(i)) < 256, Chr(Hex2Dec(StrArray(i))), "")
Text15.Text = Text15.Text & Dec2Bin(Hex2Dec(StrArray(i))) & " "
Next i
NoCalc = False
End Sub
Private Sub Text14_Change()
On Error Resume Next
Dim i As Long
If NoCalc Then Exit Sub
NoCalc = True
Text12.Text = ""
Text13.Text = ""
Text15.Text = ""
For i = 1 To Len(Text14.Text)
Text12.Text = Text12.Text & Asc(Mid(Text14.Text, i, 1)) & " "
Text13.Text = Text13.Text & Hex(Asc(Mid(Text14.Text, i, 1))) & " "
Text15.Text = Text15.Text & Dec2Bin(Asc(Mid(Text14.Text, i, 1))) & " "
Next i
NoCalc = False
End Sub
Private Sub Text15_Change()
On Error Resume Next
Dim StrArray() As String
Dim i As Integer
If NoCalc Then Exit Sub
NoCalc = True
StrArray = Split(Text15.Text, " ")
Text12.Text = ""
Text13.Text = ""
Text14.Text = ""
For i = 0 To UBound(StrArray)
Text12.Text = Text12.Text & Bin2Dec(StrArray(i)) & " "
Text13.Text = Text13.Text & Hex(CStr(Bin2Dec(StrArray(i)))) & " "
Text14.Text = Text14.Text & IIf(Bin2Dec(StrArray(i)) >= 0 And _
Bin2Dec(StrArray(i)) < 256, Chr(Bin2Dec(StrArray(i))), "")
Next i
NoCalc = False
End Sub
Private Sub Text2_Change()
If Val(Text2.Text) > 255 Then Text2.Text = "255": Text2.SelStart = Len(Text2.Text)
If Text2.Text <> "" Then Text6.Text = "Character: " + Chr(Val(Text2.Text))
If Text2.Text = "" Or Val(Text2.Text) = "0" Then Text6.Text = "Character: (null)"
End Sub
Private Sub Text2_GotFocus()
If Val(Text2.Text) = 0 Then Text2.Text = ""
Text2.SelStart = 0
Text2.SelLength = Len(Text2.Text)
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 8 Then Exit Sub
KeyAscii = 0
End Sub
Private Sub Text2_LostFocus()
Text2.Text = Val(Text2.Text)
End Sub
Private Sub Text3_Change()
On Error GoTo NoDesc
If Text3.Text <> "" Then Text4.Text = Error(Val(Text3.Text))
If Text3.Text = "" Or Val(Text3.Text) = "0" Then Text4.Text = "(No Description)"
Exit Sub
NoDesc:
Text4.Text = "(No Description)"
End Sub
Private Sub Text3_GotFocus()
If Val(Text3.Text) = 0 Then Text3.Text = ""
Text3.SelStart = 0
Text3.SelLength = Len(Text3.Text)
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 8 Then Exit Sub
KeyAscii = 0
End Sub
Private Sub Text3_LostFocus()
Text3.Text = Val(Text3.Text)
End Sub
Private Sub Text4_GotFocus()
Text4.SelStart = 0
Text4.SelLength = Len(Text4.Text)
End Sub
Private Sub Text7_Change()
Dim R, G, B
R = Val(Text7.Text)
G = Val(Text8.Text)
B = Val(Text9.Text)
If (R >= 0 And G >= 0 And B >= 0) And _
(R <= 255 And G <= 255 And B <= 255) Then
Shape1.FillColor = RGB(R, G, B)
Else
Shape1.FillColor = &H0&
End If
End Sub
Private Sub Text7_GotFocus()
Text7.SelStart = 0
Text7.SelLength = Len(Text7.Text)
End Sub
Private Sub Text7_KeyPress(KeyAscii As Integer)
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8 Or KeyAscii = 46 Then Exit Sub
KeyAscii = 0
End Sub
Private Sub Text7_LostFocus()
If Text7.Text = "" Or Val(Text7.Text) > 255 Then Text7.Text = "0"
Text7.Text = Trim(Str(Val(Text7.Text)))
End Sub
Private Sub Text8_Change()
Dim R, G, B
R = Val(Text7.Text)
G = Val(Text8.Text)
B = Val(Text9.Text)
If (R >= 0 And G >= 0 And B >= 0) And _
(R <= 255 And G <= 255 And B <= 255) Then
Shape1.FillColor = RGB(R, G, B)
Else
Shape1.FillColor = &H0&
End If
End Sub
Private Sub Text8_GotFocus()
Text8.SelStart = 0
Text8.SelLength = Len(Text8.Text)
End Sub
Private Sub Text8_KeyPress(KeyAscii As Integer)
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8 Or KeyAscii = 46 Then Exit Sub
KeyAscii = 0
End Sub
Private Sub Text8_LostFocus()
If Text8.Text = "" Or Val(Text8.Text) > 255 Then Text8.Text = "0"
Text8.Text = Trim(Str(Val(Text8.Text)))
End Sub
Private Sub Text9_Change()
Dim R, G, B
R = Val(Text7.Text)
G = Val(Text8.Text)
B = Val(Text9.Text)
If (R >= 0 And G >= 0 And B >= 0) And _
(R <= 255 And G <= 255 And B <= 255) Then
Shape1.FillColor = RGB(R, G, B)
Else
Shape1.FillColor = &H0&
End If
End Sub
Private Sub Text9_GotFocus()
Text9.SelStart = 0
Text9.SelLength = Len(Text9.Text)
End Sub
Private Sub Text9_KeyPress(KeyAscii As Integer)
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8 Or KeyAscii = 46 Then Exit Sub
KeyAscii = 0
End Sub
Private Sub Text9_LostFocus()
If Text9.Text = "" Or Val(Text9.Text) > 255 Then Text9.Text = "0"
Text9.Text = Trim(Str(Val(Text9.Text)))
End Sub