Keskustelu: Koodit: VB.NET Access kuvakikkailua ilman Officea

Imports ADOX  'COM Reference: Microsoft ADO Ext. 6.0 for DDL and Security
Imports System
Imports System.IO
Imports System.Data.OleDb
Imports mv = Microsoft.VisualBasic

' Form1 ohjausobjektiti:
' 1 PictureBox (PictureBox1)
' 3 nappia (Button1 - Button3) Tekstit: Vie kantaan, Tuo kannasta, Slide
' 1 alasvetovalikko (ComboBox1)
' 1 numericupdown (NumericUpDown1) Increment 1, Maximum 20, Minimum 1
' 1 Labelli (Label1) Teksti: Viive
' 1 OpenFileDialog (OpenFileDialog1)
' 1 SaveFileDialog (SaveFileDialog1)

Public Class Form1

    Private AllowExit As Boolean
    Private connstr As String = String.Empty
    Private dbName As String = String.Empty
    Private dbPath As String = String.Empty
    Private conn As OleDbConnection = Nothing
    Private cmd As OleDbCommand = Nothing
    Private query As String = String.Empty
    Private da As OleDbDataAdapter = Nothing
    Private ds As DataSet = Nothing
    Private cb As OleDbCommandBuilder = Nothing
    Private fInfo As FileInfo = Nothing

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

        dbName = "picbase.accdb"
        dbPath = Environment.GetFolderPath(
        Environment.SpecialFolder.Personal) + "\PicBase"
        connstr = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" + dbPath + "\" + dbName + ";"

        If Not Directory.Exists(dbPath) Then
            Directory.CreateDirectory(dbPath)
        End If

        If Not File.Exists(dbPath + "\" + dbName) Then

            Dim cat As ADOX.Catalog = New ADOX.Catalog()
            cat.Create(connstr)
            cat = Nothing

            If Dir(dbPath + "\picbase.accdb") <> "" Then

                conn = New OleDbConnection(connstr)
                cmd = conn.CreateCommand()
                cmd.CommandText = "CREATE TABLE pictures (fname " _
                + "TEXT(50) PRIMARY KEY NOT NULL, picdata OleObject NOT NULL)"
                conn.Open()
                cmd.ExecuteNonQuery()
                cmd = Nothing
                conn.Close()

            End If

        Else

            CboFill()

        End If

    End Sub

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        OpenFileDialog1.InitialDirectory =
        Environment.GetFolderPath(Environment.SpecialFolder.MyPictures)
        OpenFileDialog1.Filter =
        "Image Files (*.bmp *.jpg *.jpeg *.gif *.png *.tiff *.jfif)|*.bmp;*.jpg;*jpeg;*.gif;*.png;*.tiff;*.jfif"

        OpenFileDialog1.RestoreDirectory = True
        OpenFileDialog1.FileName = ""
        If OpenFileDialog1.ShowDialog() =
        System.Windows.Forms.DialogResult.OK Then

            Dim fname As String = OpenFileDialog1.FileName
            Dim fInfo As New FileInfo(fname)
            Dim numBytes As Long = fInfo.Length
            Dim fs As New FileStream(fname, FileMode.Open, FileAccess.Read)
            Dim br As New BinaryReader(fs)
            Dim bytes As Byte() = br.ReadBytes(CInt(numBytes))
            br.Close()
            fs.Close()

            conn = New OleDbConnection(connstr)
            query = "SELECT * FROM pictures WHERE fname = '" + fInfo.Name + "'"
            ds = New DataSet
            conn.Open()
            da = New OleDbDataAdapter(query, conn)
            cb = New OleDbCommandBuilder(da)

            da.Fill(ds, "pictures")
            If ds.Tables("pictures").Rows.Count > 0 Then
                Dim msgresult As Integer =
                MessageBox.Show("Tietokannassa on jo saman niminen kuva" _
                 + Environment.NewLine + "Korvataanko kuva?",
                 "Tietokantailmoitus",
                 MessageBoxButtons.OKCancel, MessageBoxIcon.Information)
                If msgresult <> 1 Then
                    GoTo ExitProc
                Else
                    ds.Tables("pictures").Rows(0).Delete()
                    da.Update(ds, "pictures")
                End If
            End If

            query = "SELECT * From pictures"
            cb.RefreshSchema()
            ds.Tables.Clear()
            da.TableMappings.Clear()
            da.SelectCommand = New OleDbCommand(query, conn)
            cb.DataAdapter = da
            da.Fill(ds, "pictures")
            Dim row As DataRow =
            ds.Tables("pictures").NewRow()
            row("fname") = fInfo.Name
            row("picdata") = bytes : bytes = Nothing
            ds.Tables("pictures").Rows.Add(row)
            da.Update(ds, "pictures")
ExitProc:
            fInfo = Nothing
            ds = Nothing : cb = Nothing
            da = Nothing : conn.Close()
            query = String.Empty

            CboFill()

        End If

    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click

        If ComboBox1.Items.Count = 0 Then
            MsgBox("Tietokanta ei sisällä kuvadataa!")
            Exit Sub
        End If

        conn = New OleDbConnection(connstr)
        query = "SELECT * FROM pictures"

        ds = New DataSet
        conn.Open()
        da = New OleDbDataAdapter(query, conn)
        da.Fill(ds, "pictures")
        conn.Close()
        da = Nothing : conn = Nothing

        If ds.Tables("pictures").Rows.Count > 0 Then

            Dim row As DataRow

            For Each row In ds.Tables("pictures").Rows

                Dim fname As String = (row)("fname").ToString
                fInfo = New FileInfo(fname)

                Select Case fInfo.Extension.ToLower()
                    Case ".bmp"
                        SaveFileDialog1.Filter =
                        "Bitmap (*.bmp)|*.bmp"
                    Case ".gif"
                        SaveFileDialog1.Filter =
                        "Compuserve (*.gif)|*.gif"
                    Case ".png"
                        SaveFileDialog1.Filter =
                        "Portaple (*.png)|*.png"
                    Case ".jpg"
                        SaveFileDialog1.Filter =
                        "JPG (*.jpg)|*.jpg"
                    Case ".jpeg"
                        SaveFileDialog1.Filter =
                        "JPEG (*.jpeg)|*.jpeg"
                        'jne...
                    Case ".tiff"
                        SaveFileDialog1.Filter =
                        "Tagged Image (*.tiff)|*.tiff"
                    Case ".jfif"
                        SaveFileDialog1.Filter =
                        "JPEG Interchange (*.jfif)|*.jfif"
                        'jne...
                End Select

                fInfo = Nothing

                SaveFileDialog1.InitialDirectory =
                Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
                SaveFileDialog1.FileName = (row)("fname")

                If SaveFileDialog1.ShowDialog() =
                   System.Windows.Forms.DialogResult.OK Then

                    If File.Exists(SaveFileDialog1.FileName) Then
                        FileSystem.Kill(SaveFileDialog1.FileName)
                    End If

                    Dim bytes() As Byte
                    bytes = (row)("picdata")
                    PictureBox1.Image = ArrayToImage(bytes)
                    File.WriteAllBytes(SaveFileDialog1.FileName, bytes)
                    bytes = Nothing

                Else

                    Dim dlgres As DialogResult = MessageBox.Show("Keskeytetäänkö haku?", Me.Text, MessageBoxButtons.YesNo)
                    If dlgres = DialogResult.Yes Then
                        Exit Sub
                    End If

                End If

            Next

            ds = Nothing

        End If

    End Sub

    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click

        If ComboBox1.Items.Count = 0 Then
            MsgBox("Tietokantaan ei sisällä kuvadataa!")
            Exit Sub
        End If

        Dim cnt As Integer = ComboBox1.SelectedIndex

        If cnt = ComboBox1.Items.Count - 1 Then
            cnt = 0 : ComboBox1.SelectedIndex = 0
            AllowExit = False
        End If

        If ComboBox1.Items.Count > 0 And Button3.Text = "Slide" Then

            Button3.Text = "Stop"

            For i = cnt To ComboBox1.Items.Count - 1
                If AllowExit Then
                    AllowExit = Not AllowExit : Exit For
                End If
                ComboBox1.SelectedIndex = i
                viive()
            Next

        End If

    End Sub

    Private Sub Button3_MouseUp(sender As Object, e As MouseEventArgs) Handles Button3.MouseUp

        If Button3.Text = "Stop" Then
            Button3.Text = "Slide"
            AllowExit = True
        End If

    End Sub

    Private Sub ComboBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboBox1.SelectedIndexChanged

        conn = New OleDbConnection(connstr)
        query = "SELECT * FROM pictures Where fname = '" + ComboBox1.SelectedItem + "'"
        Dim ds As DataSet = New DataSet
        conn.Open()
        Dim da As OleDbDataAdapter =
        New OleDbDataAdapter(query, conn)
        Dim cb As OleDbCommandBuilder =
        New OleDbCommandBuilder(da)
        cb.RefreshSchema()
        ds.Tables.Clear()
        da.Fill(ds, "pictures")
        conn.Close()
        cb = Nothing : da = Nothing
        PictureBox1.Image = ArrayToImage(ds.Tables(0).Rows(0).Item(1))
        ds = Nothing

    End Sub

    Sub CboFill()

        ComboBox1.Items.Clear()

        conn = New OleDbConnection(connstr)
        query = "SELECT fname FROM pictures"
        ds = New DataSet
        conn.Open()
        da = New OleDbDataAdapter(query, conn)
        da.Fill(ds, "pictures")

        If ds.Tables("pictures").Rows.Count > 0 Then

            ComboBox1.Text = "tuo tietokannasta"
            For Each row In ds.Tables("pictures").Rows
                ComboBox1.Items.Add((row)("fname"))
            Next

        End If

        If ComboBox1.Items.Count > 0 Then
            ComboBox1.SelectedIndex = 0
        End If

        conn.Close()
        conn = Nothing
        ds = Nothing
        da = Nothing

    End Sub

    Private Sub ComboBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles ComboBox1.MouseDown
        AllowExit = False : Button3.Text = "Slide"
    End Sub

    Function ArrayToImage(ByVal byteArrayIn As Byte()) As Image
        Using mStream As New MemoryStream(byteArrayIn)
            Return Image.FromStream(mStream)
        End Using
    End Function

    Sub viive()

        Dim aika As Integer = mv.Timer + NumericUpDown1.Value
        Do While aika > mv.Timer : Application.DoEvents() : Loop

    End Sub


    Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing

        Me.Dispose()

    End Sub

End Class