Sabtu, 03 Maret 2012

Kalkulator untuk menghitung matrix (matrix calculator) vb.net

PREVIEW :





























CLASS :

Option Strict Off
Option Explicit On

Imports System.Math

Public Class MatLib
    Private Shared Sub Find_R_C(ByVal Mat(,) As Double, ByRef Row As Integer, ByRef Col As Integer)
        Row = Mat.GetUpperBound(0)
        Col = Mat.GetUpperBound(1)
    End Sub

#Region "Add Matrices"

    Public Shared Function Add(ByVal Mat1(,) As Double, ByVal Mat2(,) As Double) As Double(,)
        Dim sol(,) As Double
        Dim i, j As Integer
        Dim Rows1, Cols1 As Integer
        Dim Rows2, Cols2 As Integer

        On Error GoTo Error_Handler

        Find_R_C(Mat1, Rows1, Cols1)
        Find_R_C(Mat2, Rows2, Cols2)

        If Rows1 <> Rows2 Or Cols1 <> Cols2 Then
            GoTo Error_Dimension
        End If

        ReDim sol(Rows1, Cols1)
        For i = 0 To Rows1
            For j = 0 To Cols1
                sol(i, j) = Mat1(i, j) + Mat2(i, j)
            Next j
        Next i

        Return sol

Error_Dimension:
        Err.Raise("5005", , "Dimensions of the two matrices do not match !")

Error_Handler:
        If Err.Number = 5005 Then
            Err.Raise("5005", , "Dimensions of the two matrices do not match !")
        Else
            Err.Raise("5022", , "One or both of the matrices are null, this operation cannot be done !!")
        End If

    End Function
#End Region

#Region "Subtract Matrices"
  
    Public Shared Function Subtract(ByVal Mat1(,) As Double, ByVal Mat2(,) As Double) As Double(,)
        Dim i, j As Integer
        Dim sol(,) As Double
        Dim Rows1, Cols1 As Integer
        Dim Rows2, Cols2 As Integer

        On Error GoTo Error_Handler

        Find_R_C(Mat1, Rows1, Cols1)
        Find_R_C(Mat2, Rows2, Cols2)

        If Rows1 <> Rows2 Or Cols1 <> Cols2 Then
            GoTo Error_Dimension
        End If

        ReDim sol(Rows1, Cols1)

        For i = 0 To Rows1
            For j = 0 To Cols1
                sol(i, j) = Mat1(i, j) - Mat2(i, j)
            Next j
        Next i

        Return sol

Error_Dimension:
        Err.Raise("5007", , "Dimensions of the two matrices do not match !")

Error_Handler:
        If Err.Number = 5007 Then
            Err.Raise("5007", , "Dimensions of the two matrices do not match !")
        Else
            Err.Raise("5022", , "One or both of the matrices are null, this operation cannot be done !!")
        End If

    End Function

#End Region

#Region "Multiply Matrices"
  
    Public Shared Function Multiply(ByVal Mat1(,) As Double, ByVal Mat2(,) As Double) As Double(,)
        Dim l, i, j As Integer
        Dim OptiString As String
        Dim sol(,) As Double, MulAdd As Double
        Dim Rows1, Cols1 As Integer
        Dim Rows2, Cols2 As Integer

        On Error GoTo Error_Handler

        MulAdd = 0

        Find_R_C(Mat1, Rows1, Cols1)
        Find_R_C(Mat2, Rows2, Cols2)

        If Cols1 <> Rows2 Then
            GoTo Error_Dimension
        End If

        ReDim sol(Rows1, Cols2)

        For i = 0 To Rows1
            For j = 0 To Cols2
                For l = 0 To Cols1
                    MulAdd = MulAdd + Mat1(i, l) * Mat2(l, j)
                Next l
                sol(i, j) = MulAdd
                MulAdd = 0
            Next j
        Next i

        Return sol

Error_Dimension:
        Err.Raise("5009", , "Dimensions of the two matrices not suitable for multiplication !")

Error_Handler:
        If Err.Number = 5009 Then
            Err.Raise("5009", , "Dimensions of the two matrices not suitable for multiplication !")
        Else
            Err.Raise("5022", , "One or both of the matrices are null, this operation cannot be done !!")
        End If

    End Function

#End Region

#Region "Determinant of a Matrix"
 
    Public Shared Function Det(ByVal Mat(,) As Double) As Double
        Dim DArray(,) As Double, S As Integer
        Dim k, k1, i, j As Integer
        Dim save, ArrayK As Double
        Dim M1 As String
        Dim Rows, Cols As Integer

        On Error GoTo Error_Handler

        Find_R_C(Mat, Rows, Cols)

        If Rows <> Cols Then GoTo Error_Dimension

        S = Rows
        Det = 1
        DArray = Mat.Clone()

        For k = 0 To S
            If DArray(k, k) = 0 Then
                j = k
                Do While ((j < S) And (DArray(k, j) = 0))
                    j = j + 1
                Loop
                If DArray(k, j) = 0 Then
                    Det = 0
                    Exit Function
                Else
                    For i = k To S
                        save = DArray(i, j)
                        DArray(i, j) = DArray(i, k)
                        DArray(i, k) = save
                    Next i
                End If

                Det = -Det
            End If
            ArrayK = DArray(k, k)
            Det = Det * ArrayK
            If k < S Then
                k1 = k + 1
                For i = k1 To S
                    For j = k1 To S
                        DArray(i, j) = DArray(i, j) - DArray(i, k) * (DArray(k, j) / ArrayK)
                    Next j
                Next i
            End If
        Next

        Exit Function

Error_Dimension:
        Err.Raise("5011", , "Matrix should be a square matrix !")

Error_Handler:
        If Err.Number = 5011 Then
            Err.Raise("5011", , "Matrix should be a square matrix !")
        Else
            Err.Raise("5022", , "In order to do this operation values must be assigned to the matrix !!")
        End If
    End Function

#End Region

#Region "Inverse of a Matrix"
 
    Public Shared Function Inv(ByVal Mat(,) As Double) As Double(,)
        Dim AI(,) As Double, AIN As Double, AF As Double, _
            Mat1(,) As Double
        Dim LL As Integer, LLM As Integer, L1 As Integer, _
            L2 As Integer, LC As Integer, LCA As Integer, _
            LCB As Integer, i As Integer, j As Integer
        Dim Rows, Cols As Integer

        On Error GoTo Error_Handler

        Find_R_C(Mat, Rows, Cols)
        If Rows <> Cols Then GoTo Error_Dimension

        If Det(Mat) = 0 Then GoTo Error_Zero

        LL = Rows
        LLM = Cols
        Mat1 = Mat.Clone()
        ReDim AI(LL, LL)

        For L2 = 0 To LL
            For L1 = 0 To LL
                AI(L1, L2) = 0
            Next
            AI(L2, L2) = 1
        Next

        For LC = 0 To LL
            If Abs(Mat1(LC, LC)) < 0.0000000001 Then
                For LCA = LC + 1 To LL
                    If LCA = LC Then GoTo 1090
                    If Abs(Mat1(LC, LCA)) > 0.0000000001 Then
                        For LCB = 0 To LL
                            Mat1(LCB, LC) = Mat1(LCB, LC) + Mat1(LCB, LCA)
                            AI(LCB, LC) = AI(LCB, LC) + AI(LCB, LCA)
                        Next
                        GoTo 1100
                    End If
1090:           Next
            End If

1100:
            AIN = 1 / Mat1(LC, LC)
            For LCA = 0 To LL
                Mat1(LCA, LC) = AIN * Mat1(LCA, LC)
                AI(LCA, LC) = AIN * AI(LCA, LC)
            Next

            For LCA = 0 To LL
                If LCA = LC Then GoTo 1150
                AF = Mat1(LC, LCA)
                For LCB = 0 To LL
                    Mat1(LCB, LCA) = Mat1(LCB, LCA) - AF * Mat1(LCB, LC)
                    AI(LCB, LCA) = AI(LCB, LCA) - AF * AI(LCB, LC)
                Next
1150:       Next

        Next

        Return AI

Error_Zero:
        Err.Raise("5012", , "Determinent equals zero, inverse can't be found !")

Error_Dimension:
        Err.Raise("5014", , "Matrix should be a square matrix !")

Error_Handler:
        If Err.Number = 5012 Then
            Err.Raise("5012", , "Determinent equals zero, inverse can't be found !")
        ElseIf Err.Number = 5014 Then
            Err.Raise("5014", , "Matrix should be a square matrix !")
        End If

    End Function

#End Region

#Region "Multiply Vectors"
  
    Public Shared Function MultiplyVectors(ByVal Mat1(,) As Double, ByVal Mat2(,) As Double) As Double(,)
        Dim i, j, k As Double
        Dim sol(2, 0) As Double
        Dim Rows1, Cols1 As Integer
        Dim Rows2, Cols2 As Integer

        On Error GoTo Error_Handler

        Find_R_C(Mat1, Rows1, Cols1)
        Find_R_C(Mat2, Rows2, Cols2)

        If Rows1 <> 2 Or Cols1 <> 0 Then
            GoTo Error_Dimension
        End If

        If Rows2 <> 2 Or Cols2 <> 0 Then
            GoTo Error_Dimension
        End If

        i = Mat1(1, 0) * Mat2(2, 0) - Mat1(2, 0) * Mat2(1, 0)
        j = Mat1(2, 0) * Mat2(0, 0) - Mat1(0, 0) * Mat2(2, 0)
        k = Mat1(0, 0) * Mat2(1, 0) - Mat1(1, 0) * Mat2(0, 0)

        sol(0, 0) = i : sol(1, 0) = j : sol(2, 0) = k

        Return sol

Error_Dimension:
        Err.Raise("5016", , "Dimension should be (2 x 0) for both matrices in order to do cross multiplication !")

Error_Handler:

        If Err.Number = 5016 Then
            Err.Raise("5016", , "Dimension should be (2 x 0) for both matrices in order to do cross multiplication !")
        Else
            Err.Raise("5022", , "One or both of the matrices are null, this operation cannot be done !!")
        End If

    End Function

#End Region

#Region "Magnitude of a Vector"

  
    Public Shared Function VectorMagnitude(ByVal Mat(,) As Double) As Double

        Dim Rows, Cols As Integer

        On Error GoTo Error_Handler

        Find_R_C(Mat, Rows, Cols)

        If Rows <> 2 Or Cols <> 0 Then
            GoTo Error_Dimension
        End If

        Return Sqrt(Mat(0, 0) * Mat(0, 0) + Mat(1, 0) * Mat(1, 0) + Mat(2, 0) * Mat(2, 0))

Error_Dimension:
        Err.Raise("5018", , "Dimension of the matrix should be (2 x 0) in order to find the vector's norm !")

Error_Handler:
        If Err.Number = 5018 Then
            Err.Raise("5018", , "Dimension of the matrix should be (2 x 0) in order to find the vector's magnitude !")
        Else
            Err.Raise("5022", , "In order to do this operation values must be assigned to the matrix !!")
        End If

    End Function
#End Region

#Region "Transpose of a Matrix"
  
    Public Shared Function Transpose(ByVal Mat(,) As Double) As Double(,)
        Dim Tr_Mat(,) As Double
        Dim i, j, Rows, Cols As Integer

        On Error GoTo Error_Handler

        Find_R_C(Mat, Rows, Cols)

        ReDim Tr_Mat(Cols, Rows)

        For i = 0 To Cols
            For j = 0 To Rows
                Tr_Mat(j, i) = Mat(i, j)
            Next j
        Next i

        Return Tr_Mat

Error_Handler:
        Err.Raise("5028", , "In order to do this operation values must be assigned to the matrix !!")

    End Function
#End Region

#Region "Multiply a matrix or a vector with a scalar quantity"

    Public Shared Function ScalarMultiply(ByVal Value As Double, ByVal Mat(,) As Double) As Double(,)
        Dim i, j, Rows, Cols As Integer
        Dim sol(,) As Double

        On Error GoTo Error_Handler

        Find_R_C(Mat, Rows, Cols)
        ReDim sol(Rows, Cols)

        For i = 0 To Rows
            For j = 0 To Cols
                sol(i, j) = Mat(i, j) * Value
            Next j
        Next i

        Return (sol)

Error_Handler:
        Err.Raise("5022", , "Matrix was not assigned")
    End Function

#End Region

#Region "Divide a matrix or a vector with a scalar quantity"
  
    Public Shared Function ScalarDivide(ByVal Value As Double, ByVal Mat(,) As Double) As Double(,)
        Dim i, j, Rows, Cols As Integer
        Dim sol(,) As Double

        On Error GoTo Error_Handler

        Find_R_C(Mat, Rows, Cols)
        ReDim sol(Rows, Cols)

        For i = 0 To Rows
            For j = 0 To Cols
                sol(i, j) = Mat(i, j) / Value
            Next j
        Next i

        Return sol

        Exit Function

Error_Handler:
        Err.Raise("5022", , "Matrix was not assigned")
    End Function

#End Region


#Region "Print Matrix"

   
    Public Shared Function PrintMat(ByVal Mat(,) As Double) As String
        Dim N_Rows As Integer, N_Columns, k As Integer, _
            i As Integer, j As Integer, m As Integer
        Dim StrElem As String, StrLen As Long, _
            Greatest() As Integer, LarString As String
        Dim OptiString As String, sol As String

        Find_R_C(Mat, N_Rows, N_Columns)

        sol = ""
        OptiString = ""

        ReDim Greatest(N_Columns)

        For i = 0 To N_Rows
            For j = 0 To N_Columns
                If i = 0 Then
                    Greatest(j) = 0
                    For m = 0 To N_Rows
                        StrElem = Format$(Mat(m, j), "0.0000")
                        StrLen = Len(StrElem)
                        If Greatest(j) < StrLen Then
                            Greatest(j) = StrLen
                            LarString = StrElem
                        End If
                    Next m
                    If Mid$(LarString, 1, 1) = "-" Then Greatest(j) = Greatest(j) + 1
                End If
                StrElem = Format$(Mat(i, j), "0.0000")
                If Mid$(StrElem, 1, 1) = "-" Then
                    StrLen = Len(StrElem)
                    If Greatest(j) >= StrLen Then
                        For k = 1 To (Greatest(j) - StrLen)
                            OptiString = OptiString & "  "
                        Next k
                        OptiString = OptiString & " "
                    End If
                Else
                    StrLen = Len(StrElem)
                    If Greatest(j) > StrLen Then
                        For k = 1 To (Greatest(j) - StrLen)
                            OptiString = OptiString & "  "
                        Next k
                    End If
                End If
                OptiString = OptiString & "  " & Format$(Mat(i, j), "0.0000")
            Next j
            If i <> N_Rows Then
                sol = sol & OptiString & vbCrLf
                OptiString = ""
            End If
            sol = sol & OptiString
            OptiString = ""
        Next i

        PrintMat = sol

        Exit Function
    End Function
#End Region


End Class


FORM :

Option Strict Off
Option Explicit On
Friend Class mnFrm
    Inherits System.Windows.Forms.Form
#Region "Windows Form Designer generated code "
    Public Sub New()
        MyBase.New()
        If m_vb6FormDefInstance Is Nothing Then
            If m_InitializingDefInstance Then
                m_vb6FormDefInstance = Me
            Else
                Try
                    'For the start-up form, the first instance created is the default instance.
                    If System.Reflection.Assembly.GetExecutingAssembly.EntryPoint.DeclaringType Is Me.GetType Then
                        m_vb6FormDefInstance = Me
                    End If
                Catch
                End Try
            End If
        End If
        'This call is required by the Windows Form Designer.
        InitializeComponent()
    End Sub
    'Form overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal Disposing As Boolean)
        If Disposing Then
            If Not components Is Nothing Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(Disposing)
    End Sub
    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer
    Public ToolTip1 As System.Windows.Forms.ToolTip
    Public WithEvents txtSolution As System.Windows.Forms.TextBox
    Public WithEvents CalButton As System.Windows.Forms.Button
    Public WithEvents txtDisplay As System.Windows.Forms.TextBox
    Public WithEvents Label11 As System.Windows.Forms.Label
    Public WithEvents Label10 As System.Windows.Forms.Label
    Public WithEvents Label9 As System.Windows.Forms.Label
    Public WithEvents Label8 As System.Windows.Forms.Label
    Public WithEvents Label7 As System.Windows.Forms.Label
    Public WithEvents Label6 As System.Windows.Forms.Label
    Public WithEvents Label5 As System.Windows.Forms.Label
    Public WithEvents Label4 As System.Windows.Forms.Label
    Public WithEvents Label3 As System.Windows.Forms.Label
    Public WithEvents Label2 As System.Windows.Forms.Label
    Public WithEvents Label1 As System.Windows.Forms.Label
    Public WithEvents FrmSelect As System.Windows.Forms.GroupBox
    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.
    'Do not modify it using the code editor.
    Public WithEvents Option2 As System.Windows.Forms.RadioButton
    Public WithEvents Option1 As System.Windows.Forms.RadioButton
    Public WithEvents Option3 As System.Windows.Forms.RadioButton
    Public WithEvents Option12 As System.Windows.Forms.RadioButton
    Public WithEvents Option11 As System.Windows.Forms.RadioButton
    Public WithEvents Option10 As System.Windows.Forms.RadioButton
    Public WithEvents Option9 As System.Windows.Forms.RadioButton
    Public WithEvents Option8 As System.Windows.Forms.RadioButton
    Public WithEvents Option7 As System.Windows.Forms.RadioButton
    Public WithEvents Option6 As System.Windows.Forms.RadioButton
    Public WithEvents Option5 As System.Windows.Forms.RadioButton
    Public WithEvents Option4 As System.Windows.Forms.RadioButton
    Public WithEvents Label12 As System.Windows.Forms.Label
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.components = New System.ComponentModel.Container
        Me.ToolTip1 = New System.Windows.Forms.ToolTip(Me.components)
        Me.txtSolution = New System.Windows.Forms.TextBox
        Me.CalButton = New System.Windows.Forms.Button
        Me.txtDisplay = New System.Windows.Forms.TextBox
        Me.FrmSelect = New System.Windows.Forms.GroupBox
        Me.Label12 = New System.Windows.Forms.Label
        Me.Option3 = New System.Windows.Forms.RadioButton
        Me.Option12 = New System.Windows.Forms.RadioButton
        Me.Option11 = New System.Windows.Forms.RadioButton
        Me.Option10 = New System.Windows.Forms.RadioButton
        Me.Option9 = New System.Windows.Forms.RadioButton
        Me.Option8 = New System.Windows.Forms.RadioButton
        Me.Option7 = New System.Windows.Forms.RadioButton
        Me.Option6 = New System.Windows.Forms.RadioButton
        Me.Option5 = New System.Windows.Forms.RadioButton
        Me.Option4 = New System.Windows.Forms.RadioButton
        Me.Option2 = New System.Windows.Forms.RadioButton
        Me.Option1 = New System.Windows.Forms.RadioButton
        Me.Label11 = New System.Windows.Forms.Label
        Me.Label10 = New System.Windows.Forms.Label
        Me.Label9 = New System.Windows.Forms.Label
        Me.Label8 = New System.Windows.Forms.Label
        Me.Label7 = New System.Windows.Forms.Label
        Me.Label6 = New System.Windows.Forms.Label
        Me.Label5 = New System.Windows.Forms.Label
        Me.Label4 = New System.Windows.Forms.Label
        Me.Label3 = New System.Windows.Forms.Label
        Me.Label2 = New System.Windows.Forms.Label
        Me.Label1 = New System.Windows.Forms.Label
        Me.FrmSelect.SuspendLayout()
        Me.SuspendLayout()
        '
        'txtSolution
        '
        Me.txtSolution.AcceptsReturn = True
        Me.txtSolution.BackColor = System.Drawing.SystemColors.Window
        Me.txtSolution.Cursor = System.Windows.Forms.Cursors.IBeam
        Me.txtSolution.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.txtSolution.ForeColor = System.Drawing.SystemColors.WindowText
        Me.txtSolution.Location = New System.Drawing.Point(8, 336)
        Me.txtSolution.MaxLength = 0
        Me.txtSolution.Multiline = True
        Me.txtSolution.Name = "txtSolution"
        Me.txtSolution.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.txtSolution.ScrollBars = System.Windows.Forms.ScrollBars.Both
        Me.txtSolution.Size = New System.Drawing.Size(393, 120)
        Me.txtSolution.TabIndex = 8
        Me.txtSolution.WordWrap = False
        '
        'CalButton
        '
        Me.CalButton.BackColor = System.Drawing.SystemColors.Control
        Me.CalButton.Cursor = System.Windows.Forms.Cursors.Default
        Me.CalButton.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.CalButton.ForeColor = System.Drawing.SystemColors.ControlText
        Me.CalButton.Location = New System.Drawing.Point(416, 360)
        Me.CalButton.Name = "CalButton"
        Me.CalButton.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.CalButton.Size = New System.Drawing.Size(89, 73)
        Me.CalButton.TabIndex = 1
        Me.CalButton.Text = "Hitung"
        Me.CalButton.UseVisualStyleBackColor = False
        '
        'txtDisplay
        '
        Me.txtDisplay.AcceptsReturn = True
        Me.txtDisplay.BackColor = System.Drawing.SystemColors.Window
        Me.txtDisplay.Cursor = System.Windows.Forms.Cursors.IBeam
        Me.txtDisplay.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.txtDisplay.ForeColor = System.Drawing.SystemColors.WindowText
        Me.txtDisplay.Location = New System.Drawing.Point(8, 8)
        Me.txtDisplay.MaxLength = 0
        Me.txtDisplay.Multiline = True
        Me.txtDisplay.Name = "txtDisplay"
        Me.txtDisplay.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.txtDisplay.ScrollBars = System.Windows.Forms.ScrollBars.Both
        Me.txtDisplay.Size = New System.Drawing.Size(393, 328)
        Me.txtDisplay.TabIndex = 10
        Me.txtDisplay.WordWrap = False
        '
        'FrmSelect
        '
        Me.FrmSelect.BackColor = System.Drawing.SystemColors.Control
        Me.FrmSelect.Controls.Add(Me.Label12)
        Me.FrmSelect.Controls.Add(Me.Option3)
        Me.FrmSelect.Controls.Add(Me.Option12)
        Me.FrmSelect.Controls.Add(Me.Option11)
        Me.FrmSelect.Controls.Add(Me.Option10)
        Me.FrmSelect.Controls.Add(Me.Option9)
        Me.FrmSelect.Controls.Add(Me.Option8)
        Me.FrmSelect.Controls.Add(Me.Option7)
        Me.FrmSelect.Controls.Add(Me.Option6)
        Me.FrmSelect.Controls.Add(Me.Option5)
        Me.FrmSelect.Controls.Add(Me.Option4)
        Me.FrmSelect.Controls.Add(Me.Option2)
        Me.FrmSelect.Controls.Add(Me.Option1)
        Me.FrmSelect.Controls.Add(Me.Label11)
        Me.FrmSelect.Controls.Add(Me.Label10)
        Me.FrmSelect.Controls.Add(Me.Label9)
        Me.FrmSelect.Controls.Add(Me.Label8)
        Me.FrmSelect.Controls.Add(Me.Label7)
        Me.FrmSelect.Controls.Add(Me.Label6)
        Me.FrmSelect.Controls.Add(Me.Label5)
        Me.FrmSelect.Controls.Add(Me.Label4)
        Me.FrmSelect.Controls.Add(Me.Label3)
        Me.FrmSelect.Controls.Add(Me.Label2)
        Me.FrmSelect.Controls.Add(Me.Label1)
        Me.FrmSelect.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.FrmSelect.ForeColor = System.Drawing.SystemColors.ControlText
        Me.FrmSelect.Location = New System.Drawing.Point(408, 0)
        Me.FrmSelect.Name = "FrmSelect"
        Me.FrmSelect.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.FrmSelect.Size = New System.Drawing.Size(105, 456)
        Me.FrmSelect.TabIndex = 1
        Me.FrmSelect.TabStop = False
        '
        'Label12
        '
        Me.Label12.BackColor = System.Drawing.SystemColors.Control
        Me.Label12.Cursor = System.Windows.Forms.Cursors.Default
        Me.Label12.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Label12.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Label12.Location = New System.Drawing.Point(24, 80)
        Me.Label12.Name = "Label12"
        Me.Label12.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Label12.Size = New System.Drawing.Size(56, 25)
        Me.Label12.TabIndex = 37
        Me.Label12.Text = " A x B"
        '
        'Option3
        '
        Me.Option3.BackColor = System.Drawing.SystemColors.Control
        Me.Option3.Cursor = System.Windows.Forms.Cursors.Default
        Me.Option3.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Option3.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Option3.Location = New System.Drawing.Point(8, 80)
        Me.Option3.Name = "Option3"
        Me.Option3.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Option3.Size = New System.Drawing.Size(17, 17)
        Me.Option3.TabIndex = 36
        Me.Option3.Text = "Option1"
        Me.Option3.UseVisualStyleBackColor = False
        '
        'Option12
        '
        Me.Option12.BackColor = System.Drawing.SystemColors.Control
        Me.Option12.Cursor = System.Windows.Forms.Cursors.Default
        Me.Option12.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Option12.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Option12.Location = New System.Drawing.Point(8, 296)
        Me.Option12.Name = "Option12"
        Me.Option12.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Option12.Size = New System.Drawing.Size(17, 17)
        Me.Option12.TabIndex = 35
        Me.Option12.Text = "Option1"
        Me.Option12.UseVisualStyleBackColor = False
        '
        'Option11
        '
        Me.Option11.BackColor = System.Drawing.SystemColors.Control
        Me.Option11.Cursor = System.Windows.Forms.Cursors.Default
        Me.Option11.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Option11.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Option11.Location = New System.Drawing.Point(8, 272)
        Me.Option11.Name = "Option11"
        Me.Option11.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Option11.Size = New System.Drawing.Size(17, 17)
        Me.Option11.TabIndex = 34
        Me.Option11.Text = "Option1"
        Me.Option11.UseVisualStyleBackColor = False
        '
        'Option10
        '
        Me.Option10.BackColor = System.Drawing.SystemColors.Control
        Me.Option10.Cursor = System.Windows.Forms.Cursors.Default
        Me.Option10.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Option10.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Option10.Location = New System.Drawing.Point(8, 248)
        Me.Option10.Name = "Option10"
        Me.Option10.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Option10.Size = New System.Drawing.Size(17, 17)
        Me.Option10.TabIndex = 33
        Me.Option10.Text = "Option1"
        Me.Option10.UseVisualStyleBackColor = False
        '
        'Option9
        '
        Me.Option9.BackColor = System.Drawing.SystemColors.Control
        Me.Option9.Cursor = System.Windows.Forms.Cursors.Default
        Me.Option9.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Option9.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Option9.Location = New System.Drawing.Point(8, 224)
        Me.Option9.Name = "Option9"
        Me.Option9.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Option9.Size = New System.Drawing.Size(17, 17)
        Me.Option9.TabIndex = 32
        Me.Option9.Text = "Option1"
        Me.Option9.UseVisualStyleBackColor = False
        '
        'Option8
        '
        Me.Option8.BackColor = System.Drawing.SystemColors.Control
        Me.Option8.Cursor = System.Windows.Forms.Cursors.Default
        Me.Option8.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Option8.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Option8.Location = New System.Drawing.Point(8, 200)
        Me.Option8.Name = "Option8"
        Me.Option8.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Option8.Size = New System.Drawing.Size(17, 17)
        Me.Option8.TabIndex = 31
        Me.Option8.Text = "Option1"
        Me.Option8.UseVisualStyleBackColor = False
        '
        'Option7
        '
        Me.Option7.BackColor = System.Drawing.SystemColors.Control
        Me.Option7.Cursor = System.Windows.Forms.Cursors.Default
        Me.Option7.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Option7.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Option7.Location = New System.Drawing.Point(8, 176)
        Me.Option7.Name = "Option7"
        Me.Option7.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Option7.Size = New System.Drawing.Size(17, 17)
        Me.Option7.TabIndex = 30
        Me.Option7.Text = "Option1"
        Me.Option7.UseVisualStyleBackColor = False
        '
        'Option6
        '
        Me.Option6.BackColor = System.Drawing.SystemColors.Control
        Me.Option6.Cursor = System.Windows.Forms.Cursors.Default
        Me.Option6.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Option6.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Option6.Location = New System.Drawing.Point(8, 152)
        Me.Option6.Name = "Option6"
        Me.Option6.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Option6.Size = New System.Drawing.Size(17, 17)
        Me.Option6.TabIndex = 29
        Me.Option6.Text = "Option1"
        Me.Option6.UseVisualStyleBackColor = False
        '
        'Option5
        '
        Me.Option5.BackColor = System.Drawing.SystemColors.Control
        Me.Option5.Cursor = System.Windows.Forms.Cursors.Default
        Me.Option5.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Option5.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Option5.Location = New System.Drawing.Point(8, 128)
        Me.Option5.Name = "Option5"
        Me.Option5.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Option5.Size = New System.Drawing.Size(17, 17)
        Me.Option5.TabIndex = 28
        Me.Option5.Text = "Option1"
        Me.Option5.UseVisualStyleBackColor = False
        '
        'Option4
        '
        Me.Option4.BackColor = System.Drawing.SystemColors.Control
        Me.Option4.Cursor = System.Windows.Forms.Cursors.Default
        Me.Option4.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Option4.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Option4.Location = New System.Drawing.Point(8, 104)
        Me.Option4.Name = "Option4"
        Me.Option4.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Option4.Size = New System.Drawing.Size(17, 17)
        Me.Option4.TabIndex = 27
        Me.Option4.Text = "Option1"
        Me.Option4.UseVisualStyleBackColor = False
        '
        'Option2
        '
        Me.Option2.BackColor = System.Drawing.SystemColors.Control
        Me.Option2.Cursor = System.Windows.Forms.Cursors.Default
        Me.Option2.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Option2.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Option2.Location = New System.Drawing.Point(8, 56)
        Me.Option2.Name = "Option2"
        Me.Option2.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Option2.Size = New System.Drawing.Size(17, 17)
        Me.Option2.TabIndex = 26
        Me.Option2.Text = "Option1"
        Me.Option2.UseVisualStyleBackColor = False
        '
        'Option1
        '
        Me.Option1.BackColor = System.Drawing.SystemColors.Control
        Me.Option1.Checked = True
        Me.Option1.Cursor = System.Windows.Forms.Cursors.Default
        Me.Option1.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Option1.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Option1.Location = New System.Drawing.Point(8, 32)
        Me.Option1.Name = "Option1"
        Me.Option1.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Option1.Size = New System.Drawing.Size(17, 17)
        Me.Option1.TabIndex = 25
        Me.Option1.TabStop = True
        Me.Option1.Text = "Option1"
        Me.Option1.UseVisualStyleBackColor = False
        '
        'Label11
        '
        Me.Label11.BackColor = System.Drawing.SystemColors.Control
        Me.Label11.Cursor = System.Windows.Forms.Cursors.Default
        Me.Label11.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Label11.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Label11.Location = New System.Drawing.Point(24, 104)
        Me.Label11.Name = "Label11"
        Me.Label11.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Label11.Size = New System.Drawing.Size(56, 25)
        Me.Label11.TabIndex = 24
        Me.Label11.Text = " Det (A)"
        '
        'Label10
        '
        Me.Label10.BackColor = System.Drawing.SystemColors.Control
        Me.Label10.Cursor = System.Windows.Forms.Cursors.Default
        Me.Label10.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Label10.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Label10.Location = New System.Drawing.Point(24, 296)
        Me.Label10.Name = "Label10"
        Me.Label10.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Label10.Size = New System.Drawing.Size(57, 25)
        Me.Label10.TabIndex = 23
        Me.Label10.Text = " A x Tr (B) + Inv(A)"
        '
        'Label9
        '
        Me.Label9.BackColor = System.Drawing.SystemColors.Control
        Me.Label9.Cursor = System.Windows.Forms.Cursors.Default
        Me.Label9.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Label9.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Label9.Location = New System.Drawing.Point(24, 272)
        Me.Label9.Name = "Label9"
        Me.Label9.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Label9.Size = New System.Drawing.Size(64, 25)
        Me.Label9.TabIndex = 22
        Me.Label9.Text = " B x Inv (B)"
        '
        'Label8
        '
        Me.Label8.BackColor = System.Drawing.SystemColors.Control
        Me.Label8.Cursor = System.Windows.Forms.Cursors.Default
        Me.Label8.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Label8.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Label8.Location = New System.Drawing.Point(24, 248)
        Me.Label8.Name = "Label8"
        Me.Label8.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Label8.Size = New System.Drawing.Size(57, 25)
        Me.Label8.TabIndex = 21
        Me.Label8.Text = " V2 / 3 "
        '
        'Label7
        '
        Me.Label7.BackColor = System.Drawing.SystemColors.Control
        Me.Label7.Cursor = System.Windows.Forms.Cursors.Default
        Me.Label7.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Label7.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Label7.Location = New System.Drawing.Point(24, 224)
        Me.Label7.Name = "Label7"
        Me.Label7.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Label7.Size = New System.Drawing.Size(57, 25)
        Me.Label7.TabIndex = 20
        Me.Label7.Text = " 5 A"
        '
        'Label6
        '
        Me.Label6.BackColor = System.Drawing.SystemColors.Control
        Me.Label6.Cursor = System.Windows.Forms.Cursors.Default
        Me.Label6.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Label6.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Label6.Location = New System.Drawing.Point(24, 200)
        Me.Label6.Name = "Label6"
        Me.Label6.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Label6.Size = New System.Drawing.Size(57, 25)
        Me.Label6.TabIndex = 19
        Me.Label6.Text = " | V1 |"
        '
        'Label5
        '
        Me.Label5.BackColor = System.Drawing.SystemColors.Control
        Me.Label5.Cursor = System.Windows.Forms.Cursors.Default
        Me.Label5.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Label5.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Label5.Location = New System.Drawing.Point(24, 176)
        Me.Label5.Name = "Label5"
        Me.Label5.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Label5.Size = New System.Drawing.Size(57, 25)
        Me.Label5.TabIndex = 18
        Me.Label5.Text = " V1 x V2"
        '
        'Label4
        '
        Me.Label4.BackColor = System.Drawing.SystemColors.Control
        Me.Label4.Cursor = System.Windows.Forms.Cursors.Default
        Me.Label4.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Label4.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Label4.Location = New System.Drawing.Point(24, 152)
        Me.Label4.Name = "Label4"
        Me.Label4.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Label4.Size = New System.Drawing.Size(72, 25)
        Me.Label4.TabIndex = 17
        Me.Label4.Text = "Transpose(B)"
        '
        'Label3
        '
        Me.Label3.BackColor = System.Drawing.SystemColors.Control
        Me.Label3.Cursor = System.Windows.Forms.Cursors.Default
        Me.Label3.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Label3.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Label3.Location = New System.Drawing.Point(24, 128)
        Me.Label3.Name = "Label3"
        Me.Label3.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Label3.Size = New System.Drawing.Size(57, 25)
        Me.Label3.TabIndex = 16
        Me.Label3.Text = "Inverse(A)"
        '
        'Label2
        '
        Me.Label2.BackColor = System.Drawing.SystemColors.Control
        Me.Label2.Cursor = System.Windows.Forms.Cursors.Default
        Me.Label2.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Label2.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Label2.Location = New System.Drawing.Point(24, 56)
        Me.Label2.Name = "Label2"
        Me.Label2.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Label2.Size = New System.Drawing.Size(33, 25)
        Me.Label2.TabIndex = 15
        Me.Label2.Text = " A - B"
        '
        'Label1
        '
        Me.Label1.BackColor = System.Drawing.SystemColors.Control
        Me.Label1.Cursor = System.Windows.Forms.Cursors.Default
        Me.Label1.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Label1.ForeColor = System.Drawing.SystemColors.ControlText
        Me.Label1.Location = New System.Drawing.Point(24, 32)
        Me.Label1.Name = "Label1"
        Me.Label1.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Label1.Size = New System.Drawing.Size(40, 25)
        Me.Label1.TabIndex = 14
        Me.Label1.Text = " A + B"
        '
        'mnFrm
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.ClientSize = New System.Drawing.Size(520, 456)
        Me.Controls.Add(Me.txtSolution)
        Me.Controls.Add(Me.CalButton)
        Me.Controls.Add(Me.txtDisplay)
        Me.Controls.Add(Me.FrmSelect)
        Me.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Location = New System.Drawing.Point(4, 25)
        Me.Name = "mnFrm"
        Me.FrmSelect.ResumeLayout(False)
        Me.ResumeLayout(False)
        Me.PerformLayout()

    End Sub
#End Region
#Region "Upgrade Support "
    Private Shared m_vb6FormDefInstance As mnFrm
    Private Shared m_InitializingDefInstance As Boolean
    Public Shared Property DefInstance() As mnFrm
        Get
            If m_vb6FormDefInstance Is Nothing OrElse m_vb6FormDefInstance.IsDisposed Then
                m_InitializingDefInstance = True
                m_vb6FormDefInstance = New mnFrm()
                m_InitializingDefInstance = False
            End If
            DefInstance = m_vb6FormDefInstance
        End Get
        Set
            m_vb6FormDefInstance = Value
        End Set
    End Property
#End Region
   
   
    Dim A(3, 3) As Double 'defines a matrix A with dimensions (4x4)
    Dim B(3, 3) As Double 'defines a matrix B with dimensions (4x4)
   
    Dim V1(2, 0) As Double 'define a vector V1
    Dim V2(2, 0) As Double 'define a vector V2
   
    Private Sub CalButton_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles CalButton.Click
        'Assign a dynamic matrix C
        Dim C(,) As Double
       
        Dim Determinant As Double
        Dim Magnitude As Double


        If Option1.Checked = True Then
            'Addition Case
            C = MatLib.Add(A, B) 'C = Addition of A and B

            txtSolution.Text = "Answer A + B = " & vbCrLf & vbCrLf
            txtSolution.Text = txtSolution.Text & MatLib.PrintMat(C) 'Print C

        ElseIf Option2.Checked = True Then
            'Subtraction Case

            C = MatLib.Subtract(A, B) 'C = Subtration of A from B
            'Print C
            txtSolution.Text = "Answer A - B = " & vbCrLf & vbCrLf
            txtSolution.Text = txtSolution.Text & MatLib.PrintMat(C) 'Print C

        ElseIf Option3.Checked = True Then
            'Multiplication Case

            C = MatLib.Multiply(A, B) 'C = Multiple of A and B
            'Print C
            txtSolution.Text = "Answer A x B = " & vbCrLf & vbCrLf
            txtSolution.Text = txtSolution.Text & MatLib.PrintMat(C) 'Print C

        ElseIf Option4.Checked = True Then
            'Determinant Case of Matrix A
            Determinant = MatLib.Det(A)

            txtSolution.Text = "Answer Determinant of A = " & vbCrLf & vbCrLf
            txtSolution.Text = txtSolution.Text & Determinant

        ElseIf Option5.Checked = True Then
            'Inverse Case of Matrix B
            C = MatLib.Inv(A)

            txtSolution.Text = "Answer Inverse of A = " & vbCrLf & vbCrLf
            txtSolution.Text = txtSolution.Text & MatLib.PrintMat(C)

        ElseIf Option6.Checked = True Then
            'Transpose Case of Matrix B
            C = MatLib.Transpose(B)

            txtSolution.Text = "Answer Transpose of B = " & vbCrLf & vbCrLf
            txtSolution.Text = txtSolution.Text & MatLib.PrintMat(C)

        ElseIf Option7.Checked = True Then
            'Mutiply Vectors V1 and V2 Case
            C = MatLib.MultiplyVectors(V1, V2)

            txtSolution.Text = "Answer V1 x V2 = " & vbCrLf & vbCrLf
            txtSolution.Text = txtSolution.Text & MatLib.PrintMat(C)

        ElseIf Option8.Checked = True Then
            'Magnitude of Vector V1 Case
            Magnitude = MatLib.VectorMagnitude(V1)

            txtSolution.Text = "Answer |V1| = " & vbCrLf & vbCrLf
            txtSolution.Text = txtSolution.Text & Magnitude

        ElseIf Option9.Checked = True Then
            'Scalar Multiply 5*A Case
            C = MatLib.ScalarMultiply(5, A)
            txtSolution.Text = "Answer 5A = " & vbCrLf & vbCrLf
            txtSolution.Text = txtSolution.Text & MatLib.PrintMat(C)

        ElseIf Option10.Checked = True Then
            'Scalar Divide V2/3 Case
            C = MatLib.ScalarDivide(3, V2)
            txtSolution.Text = "Answer V2 / 3 = " & vbCrLf & vbCrLf
            txtSolution.Text = txtSolution.Text & MatLib.PrintMat(C)

        ElseIf Option11.Checked = True Then
            'Case Bxinv(B)
            C = MatLib.Multiply(A, MatLib.Inv(A))
            txtSolution.Text = "Answer B x Inverse(B) = " & vbCrLf & vbCrLf
            txtSolution.Text = txtSolution.Text & MatLib.PrintMat(C)

        ElseIf Option12.Checked = True Then
            'Case AxTranspose(B)+inv(A)
            C = MatLib.Add(MatLib.Multiply(A, MatLib.Transpose(B)), MatLib.Inv(A))
            txtSolution.Text = "Answer A x Transpose(B)+Inverse(A) = " & vbCrLf & vbCrLf
            txtSolution.Text = txtSolution.Text & MatLib.PrintMat(C)
        End If

    End Sub


    Private Sub mnFrm_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
        Dim i, j As Short

        'Assign some values to matrix A and B
        A(0, 0) = 1 : A(0, 1) = 2 : A(0, 2) = 3 : A(0, 3) = 4
        A(1, 0) = 5 : A(1, 1) = 6 : A(1, 2) = 7 : A(1, 3) = 8
        A(2, 0) = 9 : A(2, 1) = 10 : A(2, 2) = 1 : A(2, 3) = 12
        A(3, 0) = 13 : A(3, 1) = -14 : A(3, 2) = 15 : A(3, 3) = 16

        For i = 0 To 3
            For j = 0 To 3
                B(i, j) = 2 * Rnd(1)
            Next j
        Next i

        'Assign some values to vectors V1 and V2
        V1(0, 0) = 1 : V1(1, 0) = 2 : V1(2, 0) = 3
        V2(0, 0) = 4 : V2(1, 0) = 5 : V2(2, 0) = 6

        'Print Matrices And Vectors
        txtDisplay.Text = "Matix A = " & vbCrLf
        txtDisplay.Text = txtDisplay.Text & MatLib.PrintMat(A) & vbCrLf & vbCrLf

        txtDisplay.Text = txtDisplay.Text & "Matix B = " & vbCrLf
        txtDisplay.Text = txtDisplay.Text & MatLib.PrintMat(B) & vbCrLf & vbCrLf

        txtDisplay.Text = txtDisplay.Text & "Vector V1 = " & vbCrLf
        txtDisplay.Text = txtDisplay.Text & MatLib.PrintMat(V1) & vbCrLf & vbCrLf

        txtDisplay.Text = txtDisplay.Text & "Vector V2 = " & vbCrLf
        txtDisplay.Text = txtDisplay.Text & MatLib.PrintMat(V2)
    End Sub

    Private Sub FrmSelect_Enter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles FrmSelect.Enter

    End Sub
End Class






SQL SERVER CLASS

PREVIEW :

DOWNLOAD CONTOH PROJECT 




























CLASS :

Imports System.Data.SqlClient

Public Class clsSQL

    Public Enum XmlType As Short
        Normal = 0
        Schema = 1
    End Enum

    Private m_StrConnectionString As String = String.Empty
    Private m_Tag As String = String.Empty

    Public Event OnError(ByVal strProced As String, ByVal objEx As Exception)

    Public Sub New(ByVal strConnectionString As String)
        m_StrConnectionString = strConnectionString
    End Sub

    Protected Overrides Sub Finalize()
        MyBase.Finalize()
    End Sub

    Public ReadOnly Property About() As String
        Get
            Return "KABEH WONG BAKAL MATI" & vbNewLine & _
                   "GARI OPO SING AREP DITINGGAL" & vbNewLine & _
                   "ORA USAH NGAREP WONG ELING MARANG TINGGALANE DEWE" & vbNewLine & _
                   "NGAREPO PENGERAN BAKAL NOMPO" & vbNewLine & _
                   "MUNG KUI SING GAWE MESEM NALIKO SEDO"
        End Get
    End Property

    Public Property ConnectionString() As String
        Get
            Return m_StrConnectionString
        End Get
        Set(ByVal strValue As String)
            m_StrConnectionString = strValue
        End Set
    End Property

    Public Property Tag() As String
        Get
            Return m_Tag
        End Get
        Set(ByVal strValue As String)
            m_Tag = strValue
        End Set
    End Property

    Public Function TestConnection() As Boolean
        Try
            Dim objConnection As New SqlConnection(m_StrConnectionString)
            objConnection.Open()

            Select Case objConnection.State
                Case ConnectionState.Broken, ConnectionState.Closed : TestConnection = False
                Case Else : TestConnection = True
            End Select

            objConnection.Close()
            objConnection.Dispose()
            objConnection = Nothing

        Catch ex As Exception
            Return False
        End Try
    End Function

    Public Function Execute(ByVal strQuery As String) As Boolean
        Try
            Dim objConnection As New SqlConnection(m_StrConnectionString)
            Dim objCommand = New SqlCommand(strQuery, objConnection)

            objConnection.Open()

            objCommand.ExecuteNonQuery()

            objConnection.Close()
            objConnection.Dispose()
            objConnection = Nothing
            objCommand = Nothing

            Return True

        Catch ex As Exception
            RaiseEvent OnError("Execute", ex)
            Return False
        End Try
    End Function

    Public Function ToDataReader(ByVal strQuery As String) As SqlDataReader
        Try
            Dim objDR As System.Data.SqlClient.SqlDataReader
            Dim objConnection As New SqlConnection(m_StrConnectionString)
            'Abre a coneção
            objConnection.Open()
            'Define o comando
            Dim objSqlCommand As New System.Data.SqlClient.SqlCommand(strQuery, objConnection)
            'Executa o reader
            objDR = objSqlCommand.ExecuteReader
            Return objDR
        Catch ex As Exception
            RaiseEvent OnError("KeDataReader", ex)
            Return Nothing
        End Try
    End Function

    Public Function ToDataSet(ByVal strQuery As String, _
                     Optional ByVal strTable As String = "") As DataSet
        Try
            Dim objConnection As New SqlConnection(m_StrConnectionString)
            'Cria o objecto
            Dim objCommand = New SqlCommand(strQuery, objConnection)
            Dim objDataSet As New DataSet
            'Cria o sql DataAdapter
            Dim objSqlDataAdapter As SqlDataAdapter = New SqlDataAdapter(objCommand)

            'Verifica se foi defenido a tabela
            If strTable = "" Then _
                 objSqlDataAdapter.Fill(objDataSet) _
            Else objSqlDataAdapter.Fill(objDataSet, strTable)

            objConnection.Close()
            objConnection.Dispose()

            objConnection = Nothing
            objCommand = Nothing

            Return objDataSet

        Catch ex As Exception
            RaiseEvent OnError("KeDataSet", ex)
            Return Nothing
        End Try
    End Function

    Public Function ToDataSetFromXML(ByVal strPath As String, _
                                     ByVal iXmlType As XmlType) As DataSet
        Try
            'Cria o objecto
            Dim objDataSet As New DataSet

            If iXmlType = XmlType.Normal Then
                objDataSet.ReadXml(strPath)
            ElseIf iXmlType = XmlType.Schema Then
                objDataSet.ReadXmlSchema(strPath)
            End If

            Return objDataSet

        Catch ex As Exception
            RaiseEvent OnError("KeDataSetFromXML", ex)
            Return Nothing
        End Try
    End Function

    Public Function ToXML(ByVal strQuery As String, _
                          ByVal strOutPut As String, _
                          ByVal iXmlType As XmlType, _
                 Optional ByVal strTable As String = "", _
                 Optional ByVal strNamespace As String = "", _
                 Optional ByVal strDataSetName As String = "") As Boolean
        Try
            Dim objDataSet As New DataSet

            Dim objConnection As New SqlConnection(m_StrConnectionString)
            Dim objCommand = New SqlCommand(strQuery, objConnection)
            Dim objSqlDataAdapter As SqlDataAdapter = New SqlDataAdapter(objCommand)

            If Not strNamespace = "" Then objDataSet.Namespace = strNamespace
            If Not strDataSetName = "" Then objDataSet.DataSetName = strDataSetName

            'Verifica se foi defenido a tabela
            If strTable = "" Then _
                 objSqlDataAdapter.Fill(objDataSet) _
            Else objSqlDataAdapter.Fill(objDataSet, strTable)

            If iXmlType = XmlType.Normal Then
                objDataSet.WriteXml(strOutPut)
            ElseIf iXmlType = XmlType.Normal Then
                objDataSet.WriteXmlSchema(strOutPut)
            End If

            objConnection.Close()
            objDataSet.Dispose()
            objConnection.Dispose()

            objConnection = Nothing
            objCommand = Nothing
            objDataSet = Nothing

            Return True

        Catch ex As Exception
            RaiseEvent OnError("KEXML", ex)
            Return False
        End Try
    End Function

    Public Function ToDataGrid(ByVal objDataGrid As DataGridView, _
                               ByVal strQuery As String, _
                      Optional ByVal strTable As String = "") As Boolean
        Try
            Dim objConnection As New SqlConnection(m_StrConnectionString)
            Dim objCommand = New SqlCommand(strQuery, objConnection)
            Dim objSqlDataAdapter As SqlDataAdapter = New SqlDataAdapter(objCommand)
            Dim objDataSet As New DataSet

            'Verifica se foi defenido a tabela
            If strTable = "" Then _
                 objSqlDataAdapter.Fill(objDataSet) _
            Else objSqlDataAdapter.Fill(objDataSet, strTable)

            objDataGrid.DataSource = objDataSet.Tables(0)

            objConnection.Close()
            objConnection.Dispose()
            objDataSet.Dispose()

            objConnection = Nothing
            objCommand = Nothing
            objDataSet = Nothing

            Return True

        Catch ex As Exception
            RaiseEvent OnError("KEDataGrid", ex)
            Return False
        End Try

    End Function

    Public Function ToListView(ByVal objListView As ListView, _
                               ByVal strQuery As String, _
                      Optional ByVal strTable As String = "", _
                      Optional ByVal intDefautColumSize As Integer = 100) As Boolean
        Try
            Dim objConnection As New SqlConnection(m_StrConnectionString)
            Dim objCommand = New SqlCommand(strQuery, objConnection)
            Dim objSqlDataAdapter As SqlDataAdapter = New SqlDataAdapter(objCommand)
            Dim objDataSet As New DataSet

            'Verifica se foi defenido a tabela
            If strTable = "" Then _
                 objSqlDataAdapter.Fill(objDataSet) _
            Else objSqlDataAdapter.Fill(objDataSet, strTable)

            If objDataSet.Tables(0).Rows.Count > 0 Then
                objListView.Items.Clear()
                objListView.Columns.Clear()
                Dim i, y As Integer
                Dim intColCount As Integer
                intColCount = objDataSet.Tables(0).Columns.Count - 1
                'Adiciona as colunas
                For i = 0 To intColCount
                    objListView.Columns.Add(objDataSet.Tables(0).Columns(i).ToString, intDefautColumSize)
                Next
                'Adiciona os registos
                Dim objLVWItem As ListViewItem
                For i = 1 To objDataSet.Tables(0).Rows.Count - 1
                    'Tem em conta valores NULL
                    If Not IsDBNull(objDataSet.Tables(0).Rows.Item(i).Item(0)) Then _
                         objLVWItem = objListView.Items.Add(objDataSet.Tables(0).Rows.Item(i).Item(0).ToString) _
                    Else objLVWItem = objListView.Items.Add("")
                    'Tem em conta valores NULL
                    For y = 1 To intColCount
                        If Not IsDBNull(objDataSet.Tables(0).Rows.Item(i).Item(y).ToString) Then _
                             objLVWItem.SubItems.Add(objDataSet.Tables(0).Rows.Item(i).Item(y).ToString) _
                        Else objLVWItem.SubItems.Add("")
                    Next
                Next
            End If

            objConnection.Close()
            objDataSet.Dispose()
            objConnection.Dispose()
            objSqlDataAdapter.Dispose()

            objCommand = Nothing
            objDataSet = Nothing
            objConnection = Nothing
            objSqlDataAdapter = Nothing

            Return True

        Catch ex As Exception
            RaiseEvent OnError("KeListView", ex)
            Return False
        End Try
    End Function

    Public Function ToTextBox(ByVal objTextBox As TextBox, _
                              ByVal strQuery As String, _
                     Optional ByVal strTable As String = "", _
                     Optional ByVal intSepTabs As Integer = 1) As Boolean
        Try
            Dim objConnection As New SqlConnection(m_StrConnectionString)
            Dim objCommand = New SqlCommand(strQuery, objConnection)
            Dim objSqlDataAdapter As SqlDataAdapter = New SqlDataAdapter(objCommand)
            Dim objDataSet As New DataSet

            'Verifica se foi defenido a tabela
            If strTable = "" Then _
                 objSqlDataAdapter.Fill(objDataSet) _
            Else objSqlDataAdapter.Fill(objDataSet, strTable)

            Dim strTabs As String = String.Empty
            Dim strTemp As String = String.Empty
            Dim x As Integer

            For x = 1 To intSepTabs
                strTabs &= vbTab
            Next

            If objDataSet.Tables(0).Rows.Count > 0 Then
                Dim i, y As Integer
                Dim intColCount As Integer

                objTextBox.Text = ""

                intColCount = objDataSet.Tables(0).Columns.Count - 1
                'Adiciona as colunas
                For i = 0 To intColCount
                    strTemp &= objDataSet.Tables(0).Columns(i).ToString & strTabs
                Next
                strTemp &= vbNewLine
                'For i = 0 To intColCount
                '    strTemp &= "---" & strTabs & vbTab
                'Next
                strTemp &= vbNewLine

                'Adiciona os registos
                For i = 1 To objDataSet.Tables(0).Rows.Count - 1
                    'Tem em conta valores NULL
                    If Not IsDBNull(objDataSet.Tables(0).Rows.Item(i).Item(0)) Then _
                         strTemp &= objDataSet.Tables(0).Rows.Item(i).Item(0).ToString & strTabs _
                    Else strTemp &= " " & strTabs
                    'Tem em conta valores NULL
                    For y = 1 To intColCount
                        If Not IsDBNull(objDataSet.Tables(0).Rows.Item(i).Item(y).ToString) Then _
                             strTemp &= objDataSet.Tables(0).Rows.Item(i).Item(y).ToString & strTabs _
                        Else strTemp &= " " & strTabs
                    Next
                    strTemp &= vbNewLine
                Next
                objTextBox.Text = strTemp
            End If

            objConnection.Close()
            objDataSet.Dispose()
            objConnection.Dispose()
            objSqlDataAdapter.Dispose()

            objCommand = Nothing
            objDataSet = Nothing
            objConnection = Nothing
            objSqlDataAdapter = Nothing

            Return True

        Catch ex As Exception
            RaiseEvent OnError("KeListView", ex)
            Return False
        End Try

    End Function

End Class


PENGGUNAAN :


Public Class frmMain

    Private WithEvents mSQL As clsSQL

    Private Sub btnAbout_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnAbout.Click
        If IsNothing(mSQL) Then
            mSQL = New clsSQL(txtConnString.Text.ToString)
        End If
        MsgBox(mSQL.About, MsgBoxStyle.Information)
    End Sub

    Private Sub SetIDE(ByVal oObject As Object)
        txtGrid1.Visible = False
        lstView1.Visible = False
        dgView1.Visible = False
        oObject.Visible = True
    End Sub

    Private Sub mSQL_OnError(ByVal strProced As String, ByVal objEx As System.Exception) Handles mSQL.OnError
        MsgBox(objEx.Message, MsgBoxStyle.Exclamation, strProced)
    End Sub

    Private Sub btnTestConn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnTestConn.Click
        If Not IsNothing(mSQL) Then
            mSQL = Nothing
        End If

        mSQL = New clsSQL(txtConnString.Text.ToString)

        If mSQL.TestConnection Then
            MsgBox("Test Koneksi OK", MsgBoxStyle.Information)
            grpOp.Enabled = True
        Else
            MsgBox("Test Koneksi Gagal", MsgBoxStyle.Exclamation)
            grpOp.Enabled = False
        End If
        'Set object visible ..
        SetIDE(Me)
    End Sub

    Private Sub btnToDataGrid_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnToDataGrid.Click
        Try
            mSQL.ToDataGrid(dgView1, txtQuery.Text.ToString)
            'Set object visible ..
            SetIDE(dgView1)
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    Private Sub btnToListView_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnToListView.Click
        Try
            mSQL.ToListView(lstView1, txtQuery.Text.ToString)
            'Set object visible ..
            SetIDE(lstView1)
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    Private Sub btnToTextBox_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnToTextBox.Click
        Try
            mSQL.ToTextBox(txtGrid1, txtQuery.Text.ToString)
            'Set object visible ..
            SetIDE(txtGrid1)
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    Private Sub btnExecute_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExecute.Click
        Try
            If mSQL.Execute(txtQuery.Text.ToString) Then
                MsgBox("Perintah SQL Error.", MsgBoxStyle.Information)
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    Private Sub btnToXML_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnToXML.Click
        Dim strTemp As String
        Try
            ofdSave.FileName = "MASSEMAR"
            ofdSave.Filter = "SEMAR XML (*.xml)|*.xml"
            If Me.ofdSave.ShowDialog(Me) = Windows.Forms.DialogResult.OK Then
                strTemp = ofdSave.FileName
            Else
                Exit Sub
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
            Exit Sub
        End Try

        Try
            If mSQL.ToXML(txtQuery.Text.ToString, strTemp, clsSQL.XmlType.Normal) Then
                MsgBox("XML file exported with success.", MsgBoxStyle.Information)
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    Private Sub btnToDataReader_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnToDataReader.Click
        Dim objDR As System.Data.SqlClient.SqlDataReader
        Try
            objDR = mSQL.ToDataReader(txtQuery.Text.ToString)

            Do While objDR.Read()
                txtGrid1.Text &= vbCrLf & objDR.Item(0)
            Loop

            objDR.Close()
            objDR = Nothing

            SetIDE(txtGrid1)

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    Private Sub btnToDataSet_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnToDataSet.Click
        Dim objDataSet As New DataSet
        Try
            objDataSet = mSQL.ToDataSet(txtQuery.Text.ToString)
            If Not IsNothing(objDataSet) Then

                txtGrid1.Text = "KeDataSet - " & objDataSet.Tables(0).Rows.Count & " row(s) affected"
                SetIDE(txtGrid1)

                objDataSet.Dispose()
                objDataSet = Nothing
            End If

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    Private Sub btnToDataSetFromXML_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnToDataSetFromXML.Click
        Dim strTemp As String
        Try
            ofdOpen.FileName = "MASSEMAR"
            ofdOpen.Filter = "SEMAR XML (*.xml)|*.xml"
            If Me.ofdOpen.ShowDialog(Me) = Windows.Forms.DialogResult.OK Then
                strTemp = ofdOpen.FileName
            Else
                Exit Sub
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
            Exit Sub
        End Try

        Dim objDataSet As New DataSet
        Try
            objDataSet = mSQL.ToDataSetFromXML(strTemp, clsSQL.XmlType.Normal)
            If Not IsNothing(objDataSet) Then

                txtGrid1.Text = "KeDataSetFromXML - " & objDataSet.Tables(0).Rows.Count & " row(s) affected"
                SetIDE(txtGrid1)

                objDataSet.Dispose()
                objDataSet = Nothing
            End If

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

End Class


Jumat, 02 Maret 2012

Print Nota LX 300 vb 6

CLASS :

DOWNLOAD CONTOH PROJECT 



Option Explicit


Public Enum PrinterErrors
vbPE_CantOpenPrinter = 2000 ' Can't Open the printer device.
vbPE_CantStartJob ' Can't Start the print job.
vbPE_CantStartPage ' Can't start printing a page.
vbPE_UnSentBytes ' Some bytes were not successfully sent to the printer.
vbPE_KillDocFailed ' Could not cancel the print job.
vbPE_CantChangeName ' Can't change document name.
vbPE_FailedWrite ' Failed write to printer.
vbPE_ReadFileError ' Could not read from file.
vbPE_CantEndPage ' Call to end page failed.
vbPE_CantEndDoc ' Call to close doc failed.
vbPE_CantChangeDevice ' Can't change device while printing.
vbPE_CantCreateDC ' Can't create a device context.
End Enum

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
pDefault As Any) As Long

Private Declare Function StartDocPrinter Lib "winspool.drv" Alias _
"StartDocPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
pDocInfo As Any) As Long

Private Declare Function StartPagePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long

Private Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long

Private Declare Function EndDocPrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long

Private Declare Function EndPagePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long

Private Type DOC_INFO_1
pDocName As String
pOutputFile As String
pDatatype As String
End Type

Private Declare Function SetJob Lib "winspool.drv" Alias _
"SetJobA" (ByVal hPrinter As Long, ByVal JobId As Long, _
ByVal Level As Long, pJob As Any, _
ByVal Command As Long) As Long

Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Private Type JOB_INFO_1
JobId As Long
pPrinterName As String
pMachineName As String
pUserName As String
pDocument As String
pDatatype As String
pStatus As String
Status As Long
Priority As Long
Position As Long
TotalPages As Long
PagesPrinted As Long
Submitted As SYSTEMTIME
End Type

Private Const JOB_POSITION_UNSPECIFIED = 0

Private Declare Function GetJob Lib "winspool.drv" Alias "GetJobA" _
(ByVal hPrinter As Long, ByVal JobId As Long, ByVal Level As Long, _
pJob As Any, ByVal cdBuf As Long, pcbNeeded As Long) As Long

Private Const MAX_PRIORITY = 99
Private Const MIN_PRIORITY = 1
Private Const DEF_PRIORITY = 1


Private Declare Function WritePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long, pBuf As Any, _
ByVal cdBuf As Long, pcWritten As Long) As Long


Private Const JOB_CONTROL_PAUSE = 1
Private Const JOB_CONTROL_RESUME = 2
Private Const JOB_CONTROL_CANCEL = 3
Private Const JOB_CONTROL_RESTART = 4
Private Const JOB_CONTROL_DELETE = 5


Private lPrinter As Long ' Printer handle
Private lBytesWritten As Long ' Number of bytes written
Private lBytesSent As Long ' Number of bytes that should have been written.
Private lJob As Long ' Print job handle
Private sDocName As String ' Name of the document
Private sDeviceName As String ' Device name.

Private bJobStarted As Boolean ' Have we started a print job.

Public Sub NewPage()
If Not bJobStarted Then
NewDoc
Else
'end last page
If EndPagePrinter(lPrinter) <= 0 Then
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Err.Raise vbPE_CantEndPage, "RAWPrinter", "Can't end page."
Exit Sub
End If

If StartPagePrinter(lPrinter) <= 0 Then
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Err.Raise vbPE_CantStartPage, "RAWPrinter", "Can't start page."
Exit Sub
End If
End If
End Sub

Public Sub NewDoc(Optional DocName As String = "", Optional FileName As String = vbNullString)
Dim di As DOC_INFO_1

If bJobStarted Then
EndDoc
End If

If OpenPrinter(sDeviceName, lPrinter, ByVal 0&) <= 0 Then
Err.Raise vbPE_CantOpenPrinter, "RAWPrinter", "Can't Open Printer Device"
Exit Sub
End If

If DocName <> "" Then
sDocName = DocName
End If

di.pDocName = sDocName & vbNullChar
If FileName = vbNullString Then
di.pOutputFile = FileName
Else
di.pOutputFile = FileName & vbNullChar
End If
di.pDatatype = "RAW" & vbNullChar

lJob = StartDocPrinter(lPrinter, 1, di)

If lJob <= 0 Then
Call ClosePrinter(lPrinter)
Err.Raise vbPE_CantStartJob, "RAWPrinter", "Can't start print job."
Exit Sub
End If

If StartPagePrinter(lPrinter) <= 0 Then
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
Err.Raise vbPE_CantStartPage, "RAWPrinter", "Can't start page."
Exit Sub
End If

lBytesWritten = 0
lBytesSent = 0
bJobStarted = True
End Sub

Public Sub KillDoc()
Dim b As Long

If bJobStarted Then
b = SetJob(lPrinter, lJob, 0, ByVal 0&, JOB_CONTROL_CANCEL)
Call EndPagePrinter(lPrinter)
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Else
b = 0
End If

If b <= 0 Then
Err.Raise vbPE_KillDocFailed, "RAWPrinter", "Could not cancle the print job."
End If
End Sub

Public Sub EndDoc()
If Not bJobStarted Then
Exit Sub
End If

If EndPagePrinter(lPrinter) <= 0 Then
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Err.Raise vbPE_CantEndPage, "RAWPrinter", "Can't end page."
Exit Sub
End If

If EndDocPrinter(lPrinter) <= 0 Then
Call ClosePrinter(lPrinter)
bJobStarted = False
Err.Raise vbPE_CantEndDoc, "RAWPrinter", "Can't end print job."
Exit Sub
End If

Call ClosePrinter(lPrinter)

bJobStarted = False

If lBytesWritten <> lBytesSent Then
Err.Raise vbPE_UnSentBytes, "RAWPrinter", "Some data was not sent to the printer."
End If
End Sub

Public Property Let DeviceName(Name As String)
If bJobStarted Then
Err.Raise vbPE_CantChangeDevice, "RAWPrinter", "Can't change device while printing."
Else
sDeviceName = Name
End If
End Property

Public Property Get DeviceName() As String
DeviceName = sDeviceName
End Property

'
' Bug... this doesn't work
'
Public Property Let DocumentName(DocName As String)
Dim di As JOB_INFO_1

If bJobStarted Then
di.pDocument = DocName & vbNullChar

If SetJob(lPrinter, lJob, 1, di, 0&) <= 0 Then
Err.Raise vbPE_CantChangeName, "RAWPrinter", "Failed to change document name."
Exit Property
End If
End If

sDocName = DocName
End Property

Public Property Get DocumentName() As String
DocumentName = sDocName
End Property

Public Sub PrintText(txt As String)
Dim i As Long

If Not bJobStarted Then
NewDoc
End If

lBytesSent = lBytesSent + Len(txt)

If WritePrinter(lPrinter, ByVal txt, Len(txt), i) = 0 Then
Call EndPagePrinter(lPrinter)
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Err.Raise vbPE_FailedWrite, "RAWPrinter", "Failed write to printer."
Exit Sub
End If

lBytesWritten = lBytesWritten + i
End Sub

Public Sub PrintFile(fname As String)
Dim fh As Long
Dim Buffer As String
Dim fl As Long
Dim r As Long
Dim i As Long
Dim bs As Long

If Not bJobStarted Then
NewDoc
End If

fh = FreeFile(0)
bs = 8192
Buffer = String(bs, 0)

Open fname For Binary Access Read As fh
fl = LOF(fh)
r = 0

If fl = 0 Then
Close fh
Exit Sub
End If

Do
If fl - r < bs Then
bs = fl - r
Buffer = String(bs, 0)
End If

Get fh, , Buffer

lBytesSent = lBytesSent + bs
r = r + bs

If WritePrinter(lPrinter, ByVal Buffer, bs, i) = 0 Then
Call EndPagePrinter(lPrinter)
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
On Error GoTo 0
Err.Raise vbPE_FailedWrite, "RAWPrinter", "Failed write to printer."
Exit Sub
End If

lBytesWritten = lBytesWritten + i
Loop While r <> fl

Close fh
Exit Sub

PrintFileError:
On Error Resume Next

Call EndPagePrinter(lPrinter)
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Close fh

On Error GoTo 0
Err.Raise vbPE_ReadFileError, "RAWPrinter", "Could not read from file."
End Sub

Private Sub Class_Initialize()
sDocName = "Cetak Nota"
sDeviceName = Printer.DeviceName
bJobStarted = False
End Sub

Private Sub Class_Terminate()
If bJobStarted Then
EndDoc
End If
End Sub

Public Property Get hPrinter() As Long
hPrinter = lPrinter
End Property

Public Property Get hJob() As Long
hJob = lJob
End Property

Public Property Get Priority() As Long
Dim di As String ' stores JOB_INFO_1
Dim i As Long

Call GetJob(lPrinter, lJob, 1, ByVal di, 0, i)
di = String(i, 0)
Call CopyMemory(i, ByVal (Mid$(di, 33, 4)), 4)

Priority = i
End Property

' Bug: Doesn't work?
Public Property Let Priority(ByVal i As Long)
Dim di As JOB_INFO_1

'JobId, pPrinterName, pMachineName, pDrivername,
'Size, Submitted, and Time are ignored
If i < MIN_PRIORITY Then
i = DEF_PRIORITY
ElseIf i > MAX_PRIORITY Then
i = MAX_PRIORITY
End If

di.Priority = i
di.Position = JOB_POSITION_UNSPECIFIED
di.pUserName = vbNullString
di.pDocument = vbNullString
di.pDatatype = vbNullString
di.pStatus = vbNullString
di.Status = 0
di.TotalPages = 0
di.PagesPrinted = 0

Call SetJob(lPrinter, lJob, 1, di, 0)
End Property


Procedure Printing


Private Sub Printing()
Dim p As New clsRAWPrinter
Open App.Path + "\cetak.txt" For Output As #1
Print #1, Tab(1); Nama
Print #1, Tab(1); Alamat
Print #1, Tab(1); "Telp. " + Telp
Print #1, Tab(1); " "
Print #1, Tab(1); "===================================="
Print #1, Tab(1); "Parkir tanggal "
Print #1, Tab(1); "No. Karcis = "
Print #1, Tab(1); "Nopol = "
Print #1, Tab(1); "Tarif = "
Print #1, Tab(1); "Petugas = "
Print #1, Tab(1); "====> Terima Kasih <==="
Print #1, Tab(1); " "
Print #1, Tab(1); " "
Print #1, Tab(1); " "
Print #1, Tab(1); " "
Print #1, Tab(1); " "
Close #1
p.PrintFile (App.Path + "\cetak.txt")
p.EndDoc
End Sub

source from :  http://www.i-bego.com