VB.NET覚書

VB.NETの覚書
[個人メモ] [仕事メモ] [アイデア] [Ruby]
[TIPS] [対応表] [コメント書き方] [.NET Tips] [VB中学校] [VB.NET の入門サイト] [VB.NET コーディング標準 ] [VBレスキュー] [NonSoft]

2019-05-11

clsExcel

'「COM」の Microsoft Excel x.x Object Library の参照設定の追加必要
Imports Microsoft.Office.Interop
Imports System.Runtime.InteropServices

Public Class clsExcel

    ''' <summary>
    ''' ファイル名
    ''' </summary>
    Public Property fileName As String

    ''' <summary>
    ''' ファイルパス
    ''' </summary>
    Public Property filePath As String

    ''' <summary>
    ''' シート名
    ''' </summary>
    Public Property sheetName As String

    Public Property app As Excel.Application = Nothing
    Public Property book As Excel.Workbook = Nothing
    Public Property sheet As Excel.Worksheet = Nothing

    ''' <summary>
    ''' セル
    ''' </summary>
    ''' <param name="y">行</param>
    ''' <param name="x">列</param>
    Public Property cells(y As Integer, x As Integer) As String
        Get
            Return sheet.Cells(y, x)
        End Get
        Set(value As String)
            sheet.Cells(y, x) = value
        End Set
    End Property

    ''' <summary>
    ''' セル書式(文字列 "@")
    ''' </summary>
    ''' <param name="y">行</param>
    ''' <param name="x">列</param>
    Public Property cellFormat(y As Integer, x As Integer) As String
        Get
            Return sheet.Range(sheet.Cells(y, x), sheet.Cells(y, x)).NumberFormatLocal
        End Get
        Set(value As String)
            sheet.Range(sheet.Cells(y, x), sheet.Cells(y, x)).NumberFormatLocal = value
        End Set
    End Property

    ''' <summary>
    ''' 列幅設定
    ''' </summary>
    ''' <param name="s">列 例("B:C")</param>
    Public Property columnWidth(s As String) As Integer
        Get
            Return sheet.Range(s).ColumnWidth
        End Get
        Set(value As Integer)
            sheet.Range(s).ColumnWidth = value
        End Set
    End Property

    ''' <summary>
    ''' 行の高さ設定
    ''' </summary>
    ''' <param name="s">行 例("2:5")</param>
    Public Property RowHeight(s As Integer) As Integer
        Get
            Return sheet.Range(s).RowHeight
        End Get
        Set(value As Integer)
            sheet.Range(s).RowHeight = value
        End Set
    End Property

    ''' <summary>
    ''' 新規作成
    ''' </summary>
    Public Function create() As Boolean

        Dim Jug As Boolean = True

        'シートの作成
        app = New Excel.Application()
        app.Workbooks.Add()
        book = app.Workbooks(1)
        sheet = CType(book.Worksheets(1), Excel.Worksheet)
        'シート名を設定する
        sheet.Name = sheetName

        Return Jug

    End Function


    ''' <summary>
    ''' ファイル保存
    ''' </summary>
    Public Function save() As Boolean

        Dim Jug As Boolean = True

        Try

            '保存する
            book.SaveAs(filePath & fileName, FileFormat:=Excel.XlFileFormat.xlExcel8)

        Catch ex As Exception
            Throw ex
            Jug = False

            'オブジェクト解放
            app.Quit()
            Marshal.ReleaseComObject(sheet)
            Marshal.ReleaseComObject(book)
            Marshal.ReleaseComObject(app)

        Finally

        End Try

        Return Jug

    End Function

    ''' <summary>
    ''' ファイル解放
    ''' </summary>
    Public Function fileClose() As Boolean

        Dim Jug As Boolean = True

        'オブジェクト解放
        app.Quit()
        Marshal.ReleaseComObject(sheet)
        Marshal.ReleaseComObject(book)
        Marshal.ReleaseComObject(app)

        Return Jug

    End Function


    'Public Sub ExcelCreate()

    '    '定義
    '    Dim app As Excel.Application = Nothing
    '    Dim book As Excel.Workbook = Nothing
    '    Dim sheet As Excel.Worksheet = Nothing

    '    'Try
    '    'シートの作成
    '    app = New Excel.Application()
    '    app.Workbooks.Add()
    '    book = app.Workbooks(1)
    '    sheet = CType(book.Worksheets(1), Excel.Worksheet)

    '    'シート名を設定する
    '    sheet.Name = sheetName

    '    'セルに値をセットする(セル名で指定する場合)
    '    sheet.Range("A1").Value = "ABC"

    '    'セルに値をセットする(番号で指定する場合)
    '    sheet.Cells(2, 1) = "DEF"   '2行・1列目(A2セル)

    '    '保存する
    '    book.SaveAs(filePath & "\" & fileName, FileFormat:=Excel.XlFileFormat.xlExcel8)

    '    'Catch ex As Exception
    '    '    Throw ex

    '    'Finally
    '    'オブジェクト解放
    '    app.Quit()
    '    Marshal.ReleaseComObject(sheet)
    '    Marshal.ReleaseComObject(book)
    '    Marshal.ReleaseComObject(app)

    '    'End Try
    'End Sub

End Class



clsTxtFile

Public Class clsTextFile
    ''' <summary>
    ''' 読み込んだデータ
    ''' </summary>
    Private m_line As New ArrayList
    ''' <summary>
    ''' ファイル名
    ''' </summary>
    Private m_filename As String

    ''' <summary>
    ''' ファイル名
    ''' </summary>
    Public Property filename As String
        Get
            Return m_filename
        End Get
        Set(value As String)
            m_filename = value
        End Set
    End Property

    ''' <summary>
    ''' 読み込んだデータ
    ''' </summary>
    Public Property line As ArrayList
        Get
            Return m_line
        End Get
        Set(value As ArrayList)
            m_line = value
        End Set
    End Property

    ''' <summary>
    ''' テキストファイル読込
    ''' </summary>
    Public Function readFile() As Boolean

        m_line.Clear()

        Return readFile_append()

    End Function

    ''' <summary>
    ''' テキストファイル書込
    ''' </summary>
    Public Function saveFile() As Boolean

        Dim F As Integer
        Dim Ret As String

        Ret = True

        F = FreeFile()

        FileOpen(F, m_filename, OpenMode.Output)

        For Each Item As String In m_line
            'System.Windows.Forms.Application.DoEvents()
            PrintLine(F, Item)
        Next

        FileClose(F)

        Return Ret

    End Function

    ''' <summary>
    ''' 追加読込
    ''' </summary>
    Public Function readFile_append() As Boolean

        Dim F As Integer
        Dim S As String
        Dim Ret As String

        Ret = True

        F = FreeFile()

        FileOpen(F, m_filename, OpenMode.Input)

        Do While Not EOF(F)
            'System.Windows.Forms.Application.DoEvents()
            S = LineInput(F)
            m_line.Add(S)
        Loop

        FileClose(F)

        Return Ret

    End Function

    ''' <summary>
    ''' 追加書込
    ''' </summary>
    Public Function saveFile_append() As Boolean

        Dim F As Integer
        Dim Ret As String

        Ret = True

        F = FreeFile()

        FileOpen(F, m_filename, OpenMode.Append)

        For Each Item As String In m_line
            'System.Windows.Forms.Application.DoEvents()
            PrintLine(F, Item)
        Next

        FileClose(F)

        Return Ret

    End Function

    ''' <summary>
    ''' CSV形式の1行から指定した列を取り出す(列番号は0から)
    ''' </summary>
    ''' <param name="str">文字列</param>
    ''' <param name="n">列</param>
    Public Function csvRead(str As String, n As Integer) As String

        Dim rdline As String()
        Dim ret As String

        rdline = str.Split(",")
        ret = rdline(n)
        Return ret

    End Function

    ''' <summary>
    ''' データ読出し
    ''' </summary>
    ''' <param name="x">列</param>
    ''' <param name="y">行</param>
    Public Function getData(x As Integer, y As Integer) As String

        Return csvRead(m_line.Item(y), x)

    End Function

    ''' <summary>
    ''' 列数を返す
    ''' </summary>
    ''' <param name="y">行</param>
    Public Function getDataColumn(y As String) As Integer

        Dim rdline As String()
        Dim ret As String

        rdline = y.Split(",")
        ret = rdline.Length
        Return ret

    End Function

End Class
トラックバック - http://sub.g.hatena.ne.jp/garyo/20190511

2019-02-12

clsBackgroundworker

Imports System.ComponentModel
'http://multithreadingapp.blogspot.com/

Enum ST_NO
    ''' <summary>
    ''' アイドル状態
    ''' </summary>
    E_IDLE
    ''' <summary>
    ''' 動作中
    ''' </summary>
    E_BUSY
    ''' <summary>
    ''' キャンセル
    ''' </summary>
    E_CANCEL
    ''' <summary>
    ''' エラー
    ''' </summary>
    E_ERR
    ''' <summary>
    ''' 終了
    ''' </summary>
    E_DONE
    ''' <summary>
    ''' 総数
    ''' </summary>
    E_ALL_NUM
End Enum
''' <summary>
''' 処理率(100で終了)
''' </summary>
''' <param name="Para">パラメータ</param>
''' <param name="Result">応答</param>
Public Delegate Function job(Para As String, ByRef Result As String) As Integer

''' <summary>
''' マルチスレッド(Backgrowndworker)クラス
''' </summary>
''' <remarks>
''' 使用例
''' 
''' Public Class Form1
''' 
'''    Dim WithEvents bgw As New clsBackGroundWorker
''' 
'''    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
''' 
'''        bgw.m_job = Function(Para As String, ByRef Result As String) As Integer
'''                        MsgBox(Para)
''' 
'''                        Result = "終了"
''' 
'''                        Return clsBackGroundWorker.MAX_PROGRESS
'''                    End Function
''' 
'''        bgw.start("開始")
''' 
'''    End Sub
''' 
'''    Private Sub bgw_completed(ByVal sender As Object, ByVal e As System.EventArgs) Handles bgw.completed
''' 
'''        MsgBox(bgw.getResult())
''' 
'''    End Sub
''' 
''' End Class
''' </remarks>
Public Class clsBackGroundWorker

    Public Const MAX_PROGRESS = 100

    Private bw As BackgroundWorker = New BackgroundWorker
    Private m_progress As Integer = 0
    Private m_status_msg As String = ""
    Private m_status_no As Integer = 0
    Private m_result As String = ""

    ''' <summary>
    ''' 実行する処理を記載 
    ''' </summary>
    Public m_job As job

    ''' <summary>
    ''' 終了処理
    ''' </summary>
    Public Event completed(ByVal sender As Object, ByVal e As EventArgs)

    Sub New()
        bw.WorkerSupportsCancellation = True
        bw.WorkerReportsProgress = True

        AddHandler bw.DoWork, AddressOf bw_DoWork
        AddHandler bw.ProgressChanged, AddressOf bw_ProgressChanged
        AddHandler bw.RunWorkerCompleted, AddressOf bw_RunWorkerCompleted

        m_status_msg = "IDLE"
        m_status_no = ST_NO.E_IDLE

    End Sub

    ''' <summary>
    ''' ステータスメッセージ
    ''' </summary>
    Function getStatusMessage() As String
        Return m_status_msg
    End Function

    ''' <summary>
    ''' ステータス変数
    ''' </summary>
    Function getStatusNo() As Integer
        Return m_status_no
    End Function

    Private Sub bw_DoWork(ByVal sender As Object, ByVal e As DoWorkEventArgs)

        Dim worker As BackgroundWorker = CType(sender, BackgroundWorker)
        Dim Ret As Integer = 0
        Dim Result As String = ""
        m_status_msg = "BUSY"
        m_status_no = ST_NO.E_BUSY

        Do While True

            Ret = m_job(CType(e.Argument, String), Result)

            If bw.CancellationPending = True Then
                e.Cancel = True
                Exit Do
            Else
                ' Perform a time consuming operation and report progress.
                bw.ReportProgress(Ret)
                If Ret = MAX_PROGRESS Then
                    Exit Do
                End If
            End If
        Loop

        e.Result = Result

    End Sub

    Private Sub bw_ProgressChanged(ByVal sender As Object, ByVal e As ProgressChangedEventArgs)
        m_progress = e.ProgressPercentage
    End Sub

    Private Sub bw_RunWorkerCompleted(ByVal sender As Object, ByVal e As RunWorkerCompletedEventArgs)

        If e.Cancelled = True Then
            m_status_msg = "Canceled!"
            m_status_no = ST_NO.E_CANCEL
        ElseIf e.Error IsNot Nothing Then
            m_status_msg = "Error: " & e.Error.Message
            m_status_no = ST_NO.E_ERR
        Else
            m_status_msg = "Done!"
            m_status_no = ST_NO.E_DONE
            'MsgBox("Done")
            m_result = e.Result.ToString()
            RaiseEvent completed(Me, New EventArgs)
        End If

    End Sub

    ''' <summary>
    ''' スレッドを開始
    ''' </summary>
    Public Sub start(x As String)
        If Not bw.IsBusy = True Then
            bw.RunWorkerAsync(x)
        End If
    End Sub

    ''' <summary>
    ''' キャンセル処理
    ''' </summary>
    Public Sub cancel()
        If bw.WorkerSupportsCancellation = True Then
            bw.CancelAsync()
        End If
    End Sub

    ''' <summary>
    ''' 処理状況を返す(0-100)
    ''' </summary>
    Public Function getProgress() As Integer
        Return m_progress
    End Function

    ''' <summary>
    ''' 結果
    ''' </summary>
    Public Function getResult() As String

        Return m_result

    End Function

End Class

使用

Public Class Form1

    Dim WithEvents bgw As New clsBackGroundWorker

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

        bgw.m_job = Function(Para As String, ByRef Result As String) As Integer
                        MsgBox(Para)

                        Result = "終了"

                        Return clsBackGroundWorker.MAX_PROGRESS
                    End Function

        bgw.start("開始")

    End Sub

    Private Sub bgw_completed(ByVal sender As Object, ByVal e As System.EventArgs) Handles bgw.completed

        MsgBox(bgw.getResult())

    End Sub

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

    End Sub
End Class



backgroundworker 引数戻り値

http://www.atmarkit.co.jp/fdotnet/dotnettips/436bgworker/bgworker.html

Imports System.ComponentModel

Public Class Form1

  ' [スタート]ボタンのイベント・ハンドラ
  Private Sub buttonStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles buttonStart.Click
    buttonStart.Enabled = False

    ' 時間のかかる処理を別スレッドで開始
    bgWorker.RunWorkerAsync(100)
    ' DoWorkイベント発生
  End Sub

  ' 時間のかかる処理を行うメソッド
  Private Sub bgWorker_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles bgWorker.DoWork
    ' 別スレッドで実行されるため、このメソッドでは
    ' UI(コントロール)を操作してはいけない

    ' このメソッドへのパラメータ
    Dim bgWorkerArg As Integer = CType(e.Argument, Integer)

    ' senderの値はbgWorkerの値と同じ
    Dim worker As BackgroundWorker = CType(sender, BackgroundWorker)

    ' 時間のかかる処理
    For i As Integer = 1 To bgWorkerArg

      System.Threading.Thread.Sleep(100)

      Dim percentage As Integer = i * 100 / bgWorkerArg ' 進ちょく率
      worker.ReportProgress(percentage)
      ' ProgressChangedイベント発生
    Next

    ' このメソッドからの戻り値
    e.Result = "すべて完了"

    ' この後、RunWorkerCompletedイベントが発生
  End Sub

  Private Sub bgWorker_ProgressChanged(ByVal sender As Object, ByVal e As System.ComponentModel.ProgressChangedEventArgs) Handles bgWorker.ProgressChanged
    ' 進ちょく状況の表示
    Me.Text = e.ProgressPercentage & "%完了"
    progressBar.Value = e.ProgressPercentage
  End Sub

  Private Sub bgWorker_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles bgWorker.RunWorkerCompleted
    ' 処理結果の表示
    Me.Text = e.Result.ToString()
    MessageBox.Show("正常に完了")

    buttonStart.Enabled = True
  End Sub
End Class
トラックバック - http://sub.g.hatena.ne.jp/garyo/20190212

2019-02-08

トラックバック - http://sub.g.hatena.ne.jp/garyo/20190208

2019-02-06

デリゲートラムダ式

Public Delegate Function Func1(ByVal msg As String) As Boolean

デリゲート関数の戻りの型と引数の型を定義した関数ポインタ型みたいなもので、その型で定義した変数に、同じ型のラムダ式を代入できる。

デリゲートインスタンス化でき、その時にはnewと既存関数へのAddressOfを使用する

Public Delegate Sub Sub1()

Dim s = New Sub1(AddressOf test)

Public Class Form1

    Public Delegate Function Func1(x As Integer) As Integer
    Public Delegate Sub Sub1()
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click

        Dim y As Func1

        Dim inc As Func1 = Function(x) x + 1

        Dim inc2 As Func1 = Function(x)
                                Return x + 2
                            End Function

        y = inc
        MsgBox(y(1))
        y = inc2
        MsgBox(y(1))

           Dim s As Sub1

        s = New Sub1(AddressOf test)

        s()

    End Sub

    Sub test()
        MsgBox("test")
    End Sub

End Class

マルチスレッド

Public Class Form1

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

        Me.BackgroundWorker1.RunWorkerAsync()

    End Sub

    Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
        Do
            Label1.Text = Now.ToLongTimeString()
            Threading.Thread.Sleep(1000)
        Loop
    End Sub

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        Control.CheckForIllegalCrossThreadCalls = False
    End Sub
End Class


プログレスバーマルチスレッド

Public Class Form1

    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        BackgroundWorker1.WorkerReportsProgress = True
        BackgroundWorker1.WorkerSupportsCancellation = True
        BackgroundWorker1.RunWorkerAsync()

    End Sub

    Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork

        For i As Integer = 1 To 100
            Threading.Thread.Sleep(1000)

            If BackgroundWorker1.CancellationPending = True Then
                e.Cancel = True
                Exit For
            End If
            BackgroundWorker1.ReportProgress(i)
        Next
    End Sub

    Private Sub BackgroundWorker1_ProgressChanged(sender As Object, e As System.ComponentModel.ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged
        ProgressBar1.Value = e.ProgressPercentage
    End Sub

    Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
        MsgBox("終了")
        ProgressBar1.Value = 0
    End Sub

    Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
        BackgroundWorker1.CancelAsync()
    End Sub

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

    End Sub
End Class

マルチスレッドクラス

Imports System.ComponentModel
'http://multithreadingapp.blogspot.com/

Enum ST_NO
    E_IDLE
    E_BUSY
    E_CANCEL
    E_ERR
    E_DONE
    E_ALL_NUM
End Enum
Public Delegate Function Job() As Integer

Public Class clsMultiThread

    Dim bw As BackgroundWorker = New BackgroundWorker
    Dim m_progress As Integer = 0
    Dim m_status_msg As String = ""
    Dim m_status_no As Integer = 0

    Public m_job As Job

    Sub New()
        bw.WorkerSupportsCancellation = True
        bw.WorkerReportsProgress = True

        AddHandler bw.DoWork, AddressOf bw_DoWork
        AddHandler bw.ProgressChanged, AddressOf bw_ProgressChanged
        AddHandler bw.RunWorkerCompleted, AddressOf bw_RunWorkerCompleted

        m_status_msg = "IDLE"
        m_status_no = ST_NO.E_IDLE

    End Sub

    Function getStatusMessage() As String
        Return m_status_msg
    End Function

    Function getStatusNo() As Integer
        Return m_status_no
    End Function

    Private Sub bw_DoWork(ByVal sender As Object, ByVal e As DoWorkEventArgs)

        Dim worker As BackgroundWorker = CType(sender, BackgroundWorker)
        m_status_msg = "BUSY"
        m_status_no = ST_NO.E_BUSY

        Dim Ret As Integer

        Do While True

            Ret = m_job()

            If bw.CancellationPending = True Then
                e.Cancel = True
                Exit Do
            Else
                ' Perform a time consuming operation and report progress.
                System.Threading.Thread.Sleep(500)
                bw.ReportProgress(Ret)
            End If

        Loop



        For i = 1 To 10
            If bw.CancellationPending = True Then
                e.Cancel = True
                Exit For
            Else
                ' Perform a time consuming operation and report progress.
                System.Threading.Thread.Sleep(500)
                bw.ReportProgress(i * 10)
            End If
        Next
    End Sub

    Private Sub bw_ProgressChanged(ByVal sender As Object, ByVal e As ProgressChangedEventArgs)
        m_progress = e.ProgressPercentage
        'Me.tbProgress.Text = e.ProgressPercentage.ToString() & "%"
    End Sub

    Private Sub bw_RunWorkerCompleted(ByVal sender As Object, ByVal e As RunWorkerCompletedEventArgs)
        If e.Cancelled = True Then
            m_status_msg = "Canceled!"
            m_status_no = ST_NO.E_CANCEL
            'Me.tbProgress.Text = "Canceled!"
        ElseIf e.Error IsNot Nothing Then
            m_status_msg = "Error: " & e.Error.Message
            m_status_no = ST_NO.E_ERR
            'Me.tbProgress.Text = "Error: " & e.Error.Message
        Else
            m_status_msg = "Done!"
            m_status_no = ST_NO.E_DONE
            'Me.tbProgress.Text = "Done!"
            MsgBox("Done")
        End If
    End Sub

    Public Sub start()
        If Not bw.IsBusy = True Then
            bw.RunWorkerAsync()
        End If
    End Sub

    Public Sub cancel()
        If bw.WorkerSupportsCancellation = True Then
            bw.CancelAsync()
        End If
    End Sub

End Class

トラックバック - http://sub.g.hatena.ne.jp/garyo/20190206

2018-03-28

スクロールバーを一番下へスクロール

https://dobon.net/vb/dotnet/control/tbscrolltolast.html

'カレット位置を末尾に移動
TextBox1.SelectionStart = TextBox1.Text.Length
'テキストボックスにフォーカスを移動
TextBox1.Focus()
'カレット位置までスクロール
TextBox1.ScrollToCaret()
トラックバック - http://sub.g.hatena.ne.jp/garyo/20180328