VERSION 5.00
Begin VB.Form frmBase 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "Base Calculator r1.3"
   ClientHeight    =   2895
   ClientLeft      =   5940
   ClientTop       =   3735
   ClientWidth     =   3345
   Icon            =   "frmBase.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2895
   ScaleWidth      =   3345
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton Command2 
      Caption         =   "&About"
      Height          =   375
      Left            =   2160
      TabIndex        =   9
      Top             =   240
      Width           =   1095
   End
   Begin VB.CommandButton cmdCalculate 
      Caption         =   "&Calculate"
      Default         =   -1  'True
      Height          =   375
      Left            =   1200
      TabIndex        =   8
      Top             =   2400
      Width           =   1095
   End
   Begin VB.Frame Frame1 
      Caption         =   "Converter"
      Height          =   1095
      Left            =   360
      TabIndex        =   3
      Top             =   1200
      Width           =   2895
      Begin VB.OptionButton optBtoH 
         Caption         =   "Bin To Hex"
         Height          =   255
         Left            =   1440
         TabIndex        =   7
         Top             =   720
         Width           =   1095
      End
      Begin VB.OptionButton optBtoD 
         Caption         =   "Bin To Dec"
         Height          =   255
         Left            =   120
         TabIndex        =   6
         Top             =   720
         Width           =   1215
      End
      Begin VB.OptionButton optHtoB 
         Caption         =   "Hex To Bin"
         Height          =   255
         Left            =   1440
         TabIndex        =   5
         Top             =   360
         Width           =   1095
      End
      Begin VB.OptionButton optDtoB 
         Caption         =   "Dec To Bin"
         Height          =   255
         Left            =   120
         TabIndex        =   4
         Top             =   360
         Width           =   1215
      End
   End
   Begin VB.TextBox txtOutput 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00800000&
      Height          =   375
      Left            =   360
      TabIndex        =   1
      Text            =   "TEXT2"
      Top             =   720
      Width           =   2895
   End
   Begin VB.TextBox txtInput 
      Alignment       =   1  'Right Justify
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   360
      TabIndex        =   0
      Text            =   "TEXT1"
      Top             =   240
      Width           =   2895
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "="
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   21.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000C0&
      Height          =   495
      Left            =   60
      TabIndex        =   2
      Top             =   675
      Width           =   255
   End
   Begin VB.Menu mnuFile 
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit 
         Caption         =   "Exit"
         Shortcut        =   {F4}
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "&Edit"
      Begin VB.Menu mnuEditCopy 
         Caption         =   "Copy"
         Shortcut        =   ^C
      End
      Begin VB.Menu mnuEditSep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEditCut 
         Caption         =   "Cut"
         Shortcut        =   ^X
      End
      Begin VB.Menu mnuEditSep2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEditPaste 
         Caption         =   "Paste"
         Shortcut        =   ^V
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "&Help"
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "About"
         Shortcut        =   ^A
      End
   End
End
Attribute VB_Name = "frmBase"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Function DecToBin(ByVal getNumber As Long) As String
  
  'Creates Decimal To Binary Function
 Dim getValue As String, getNum As Integer
 
 getValue = Hex(getNumber)     'Using Built in Function
 getValue = HexToBin(getValue) ' Converting to ours one
 
   'Take Care about the front "0"'s by looping
  Do While Left(getValue, 1) = "0"
    getValue = Mid(getValue, 2)
  Loop
    
    DecToBin = getValue
  
End Function
Function BinToDec(ByVal getNumber As String) As Long
 
  BinToDec = Val("&H" & BinToHex(getNumber)) 'Returns
  
End Function
Function BinToHex(ByVal getNumber As String) As String
 
 Dim getValue As String, getOutPut As String
 Dim getNum As Integer, getLen As Integer
 
 'Get the length of the string
 getLen = Len(getNumber)
 
 'get Higher Multiple of 4
 getLen = Int(getLen / 4 + 1) * 4
 getNumber = Right$(String(getLen, "0") & getNumber, getLen)
 
 'take 4 digits and convert each 4 digits int to hex number
 For getNum = 1 To getLen Step 4
    Select Case Mid(getNumber, getNum, 4)
       Case "0000":   getValue = "0"
       Case "0001":   getValue = "1"
       Case "0010":   getValue = "2"
       Case "0011":   getValue = "3"
       Case "0100":   getValue = "4"
       Case "0101":   getValue = "5"
       Case "0110":   getValue = "6"
       Case "0111":   getValue = "7"
       Case "1000":   getValue = "8"
       Case "1001":   getValue = "9"
       Case "1010":   getValue = "A"
       Case "1011":   getValue = "B"
       Case "1100":   getValue = "C"
       Case "1101":   getValue = "D"
       Case "1110":   getValue = "E"
       Case "1111":   getValue = "F"
       Case Else:     getValue = ""
     End Select
     
 getOutPut = getOutPut & getValue
 Next getNum
 BinToHex = getOutPut

End Function
Function HexToBin(getNumber As String) As String

    Dim getValue As String, getOutPut As String
    Dim i As Integer
    
   For i = 1 To Len(getNumber)
      Select Case Mid(getNumber, i, 1)
           Case "0":   getValue = "0000"
           Case "1":   getValue = "0001"
           Case "2":   getValue = "0010"
           Case "3":   getValue = "0011"
           Case "4":   getValue = "0100"
           Case "5":   getValue = "0101"
           Case "6":   getValue = "0110"
           Case "7":   getValue = "0111"
           Case "8":   getValue = "1000"
           Case "9":   getValue = "1001"
           Case "A":   getValue = "1010"
           Case "B":   getValue = "1011"
           Case "C":   getValue = "1100"
           Case "D":   getValue = "1101"
           Case "E":   getValue = "1110"
           Case "F":   getValue = "1111"
           Case Else
          'Case Else:  getValue = ""
      End Select
      getOutPut = getOutPut & getValue
    Next i
    HexToBin = getOutPut
End Function



Private Sub cmdCalculate_Click()
On Error GoTo erroverflow
txtInput.Text = ChkForString(txtInput.Text)

  If optDtoB.Value = True Then
  
     If txtInput.Text <> "" Then
     txtOutput.Text = DecToBin(Int(txtInput.Text))
     Else
     MsgBox "Give a Valid Number Please ...", vbExclamation, "Input"
     txtInput.SetFocus
     End If
  ElseIf optBtoD.Value = True Then
     
     txtInput.Text = ChkForBinary(txtInput.Text)
     If txtInput.Text <> "" Then
     txtOutput.Text = BinToDec(txtInput.Text)
     Else
     MsgBox "Give a Valid Number Please ...", vbExclamation, "Input"
     txtInput.SetFocus
     End If
  ElseIf optHtoB.Value = True Then
     If txtInput.Text <> "" Then
     txtOutput.Text = HexToBin(txtInput.Text)
     Else
  MsgBox "Give a Valid Number Please ...", vbExclamation, "Input"
     txtInput.SetFocus
     End If
  ElseIf optBtoH.Value = True Then
     txtInput.Text = ChkForBinary(txtInput.Text)
     If txtInput.Text <> "" Then
     txtOutput.Text = BinToHex(txtInput.Text)
     Else
     MsgBox "Give a Valid Number Please ...", vbExclamation, "Input"
     txtInput.SetFocus
     End If
  End If
  
  
erroverflow:

If Err.Number = 6 Then
  MsgBox "Can Not Calculate this Huge Number!!!", vbExclamation, "Error"
  txtInput.SetFocus
 Exit Sub
End If

End Sub

Private Sub Command2_Click()
 Call mnuHelpAbout_Click
End Sub

Private Sub Form_Load()
Command2.Visible = False
txtInput.Text = ""
txtOutput.Text = ""
optDtoB.Value = True
End Sub

Private Sub mnuEditCopy_Click()
Clipboard.Clear
Clipboard.SetText txtOutput.SelText
End Sub

Private Sub mnuEditCut_Click()
Clipboard.Clear
Clipboard.SetText txtOutput.SelText
txtOutput.SelText = ""
End Sub

Private Sub mnuEditPaste_Click()
txtInput.SelText = Clipboard.GetText
End Sub

Private Sub mnuFileExit_Click()

Unload Me
End Sub

Private Sub mnuHelpAbout_Click()
Dim A As String

A = "Base Calculator 1.01" & vbCrLf
A = A + "(c) Copyright 2003 Shuvro Softwares, Inc." & vbCrLf
A = A + "" & vbCrLf
A = A + "Programmed By: Shuvro" & vbCrLf
A = A + "Binary To HexaDecimal Function By Niton" & vbCrLf
A = A + "Interface By Shuvro" & vbCrLf
A = A + "Idea By: Akash Bhai" & vbCrLf
A = A + "Dedicated to: Anik Rudra and Sakib" & vbCrLf
A = A + "" & vbCrLf
A = A + "Contact Me:" & vbCrLf
A = A + "<shuvro@shuvrosoft.cjb.net>" & vbCrLf
A = A + "Bugs Report:" & vbCrLf
A = A + "<calculator@shuvrosoft.cjb.net>" & vbCrLf
A = A + "http://www.shuvrosofts.tk" & vbCrLf
A = A + "http://www.shuvrosoft.cjb.net" & vbCrLf
A = A + "M a d e  I n  B A N G L A D E S H " & vbCrLf

MsgBox A, vbInformation, "About Base Calculator"


End Sub

Private Sub optBtoD_GotFocus()
' txtInput.Text = BinToDec(txtInput.Text)
End Sub

Private Sub optBtoH_GotFocus()
' txtInput.Text = BinToHex(txtInput.Text)
End Sub

Private Sub optDtoB_GotFocus()
' txtInput.Text = DecToBin(Int(txtInput.Text))
End Sub

Private Sub optHtoB_GotFocus()
' txtInput.Text = HexToBin(txtInput.Text)
End Sub
Function ChkForString(ByVal getNumber As String) As String
 
 Dim getValue As String, getOutPut As String
 Dim getNum As Integer, getLen As Integer
 
 'Get the length of the string
 getLen = Len(getNumber)
 
 'get Higher Multiple of 4
 'getLen = Int(getLen / 4 + 1) * 4
 getNumber = Right$(String(getLen, "0") & getNumber, getLen)
 
 'take 4 digits and convert each 4 digits int to hex number
 For getNum = 1 To getLen Step 1
    Select Case Mid(getNumber, getNum, 1)
       Case "0":   getValue = "0"
       Case "1":   getValue = "1"
       Case "2":   getValue = "2"
       Case "3":   getValue = "3"
       Case "4":   getValue = "4"
       Case "5":   getValue = "5"
       Case "6":   getValue = "6"
       Case "7":   getValue = "7"
       Case "8":   getValue = "8"
       Case "9":   getValue = "9"
       Case Else:   getValue = ""
     End Select
     
 getOutPut = getOutPut & getValue
 Next getNum
 ChkForString = getOutPut

End Function

Function ChkForBinary(ByVal getNumber As String) As String
 
 Dim getValue As String, getOutPut As String
 Dim getNum As Integer, getLen As Integer
 
 'Get the length of the string
 getLen = Len(getNumber)
 
 'get Higher Multiple of 4
 'getLen = Int(getLen / 4 + 1) * 4
 getNumber = Right$(String(getLen, "0") & getNumber, getLen)
 
 'take 4 digits and convert each 4 digits int to hex number
 For getNum = 1 To getLen Step 1
    Select Case Mid(getNumber, getNum, 1)
       Case "0":   getValue = "0"
       Case "1":   getValue = "1"
       Case Else
                   getValue = ""
                   MsgBox "Binary Function Can Not Accept String or Decimal Number." & vbCrLf & _
                          "So Automatically Cutting out the Decimal number or String", _
                          vbExclamation, "Error"
    End Select
     
 getOutPut = getOutPut & getValue
 Next getNum
 ChkForBinary = getOutPut
 

End Function

