iTextSharpで帳票をPDFで作成 Cell仕様 VB.Net
環境 Windows11 23H2 & Visual Studio 2022 & SQLServer 2022 & iTextSharp & WebView2 (NuGetよりインストール)
iTextSharp クラスライブラリリファレンスの詳細情報 : Vector ソフトを探す！
メイン画面
処理選択メニュー
設定メニュー
照会メニュー
照会は、指定したフォルダーのPDFを確認できます。更に、ブラウザとしても利用できます。
用紙方向の選択
用紙は、A4が基本になります。Ａ４以外は、custom指定で処理します。
設定ファイル登録
作成されたPDFを表示
照会は、WebView2を利用しているのでPDFファイルだけでなく、サイト入力できるのでブラウザになります。
ソリューション
Form1.vb
Imports System.Data.OleDb
Imports System.Drawing.Drawing2D
Imports System.Drawing.Printing
Imports System.IO
Imports System.Net.WebRequestMethods
Imports System.Reflection
Imports System.Windows.Forms.VisualStyles.VisualStyleElement
Imports iTextSharp.text
Imports iTextSharp.text.pdf
Imports iTextSharp.text.Font
Imports File = System.IO.File
Imports iTextSharp.awt.geom.Point2D
Public Class Form1
Private doc As Document
Private pw As PdfWriter
Private pcb As PdfContentByte
Private font1 As Font
Private font2 As Font
Private font3 As Font
Private font4 As Font
'フォントカラー
Private BaseColor As BaseColor = BaseColor.BLACK
Private BlueColor As BaseColor = BaseColor.BLUE
' フォント用のシステムフォルダ
Private windir As String = System.Environment.GetEnvironmentVariable("windir")
'1PT = 1/72inch = 0.3528mm 10PT=3.528mm
'A4横 x=842 y=595.22
'A4縦 X=592.22 Y=842
'A4Portrait, A4Landscape, Custom
'Pdfページ名
Private pageName As String
'最大行数( 1ページに印刷する行数 )
Private rowMax As Integer
'ページ数
Private pageCount As Integer = 0
'行数(印字する行位置)
Private prtRow As Integer = 1
' 印字用テキスト
Private prtText As System.Drawing.Graphics
' マージン
Private TopMargin As Integer
Private LeftMargin As Integer
' 外部データ
Private ReadFile As StreamReader
Private LineText As String
Private co As New OleDb.OleDbConnection
Private rs As OleDb.OleDbDataReader
Private cmd As New OleDb.OleDbCommand
Private rsRet As Boolean = False
'-------------------------------------------------------
' フォーム初期処理
'-------------------------------------------------------
Private Sub Form1_Load(ByVal sender As System.Object,
ByVal e As System.EventArgs) Handles MyBase.Load
INI()
Me.KeyPreview = True
'用紙方向セット
TextBox3.Text = "縦"
ComboBox3.Items.Clear()
ComboBox3.Items.Add("縦")
ComboBox3.Items.Add("横")
Label2.Text = "出力フォルダーは、" + OutDir + " です。"
End Sub
'-------------------------------------------------------
' keyDown処理 Endボタンで終了
'-------------------------------------------------------
Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
If e.KeyCode = Keys.End Then
End
End If
End Sub
'-------------------------------------------------------
' keyPress処理 Enter = tab
'-------------------------------------------------------
Private Sub Form1_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles MyBase.KeyPress
If e.KeyChar = Chr(13) Then
SendKeys.Send("{TAB}")
e.Handled = True
End If
End Sub
'-------------------------------------------------------
'用紙方向コンボ処理
'-------------------------------------------------------
Private Sub ComboBox3_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles ComboBox3.SelectedIndexChanged
TextBox3.Text = ComboBox3.Text
End Sub
'-------------------------------------------------------
' 終了ボタン処理
'-------------------------------------------------------
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
End
End Sub
'-------------------------------------------------------
' 印刷メニュー処理
'-------------------------------------------------------
Private Sub 印刷ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 印刷ToolStripMenuItem.Click
pdfCreate()
End Sub
'-------------------------------------------------------
' 終了メニュー処理
'-------------------------------------------------------
Private Sub 終了ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 終了ToolStripMenuItem.Click
End
End Sub
'-------------------------------------------------------
' 設定メニュー処理 Para.iniの登録へ
'-------------------------------------------------------
Private Sub 設定ToolStripMenuItem1_Click(sender As Object, e As EventArgs) Handles 設定ToolStripMenuItem1.Click
Dim iform2 As New Form2
iform2.ShowDialog()
Label2.Text = "出力フォルダーは、" + OutDir + " です。"
End Sub
'-------------------------------------------------------
' 印刷ボタン処理
'-------------------------------------------------------
Private Sub Button1_Click(ByVal sender As System.Object,
ByVal e As System.EventArgs) Handles Button1.Click
pdfCreate()
End Sub
'-------------------------------------------------------
' 印刷の前処理
'-------------------------------------------------------
Private Sub docPdf_BeginPdf()
Dim Count As Integer
Try
co.ConnectionString = CoString
co.Open()
cmd.Connection() = co
cmd.CommandText = "select * from 取引先マスター order by 取引先コード"
Count = cmd.ExecuteScalar()
rs = cmd.ExecuteReader()
Catch ex As OleDbException
MsgBox("データベース接続エラーです。" & vbCr _
& ex.Message & vbCr _
& "終了します")
Return
End Try
' 用意したレコードセットにデータが無い場合印字処理を行わない
If Count = 0 Then
MessageBox.Show("印字データが存在しません")
Return
End If
End Sub
Private Sub pdfCreate()
Dim nowTime As Date
Dim str_nowTime As String
nowTime = DateTime.Now
str_nowTime = nowTime.ToString("yyyyMMdd_HHmmss")
' PDF 出力パス
Dim pdf As String = OutDir & "取引先一覧表_" + str_nowTime + ".pdf"
If TextBox3.Text = "縦" Then
doc = New Document(PageSize.A4)
Else
doc = New Document(PageSize.A4.Rotate())
End If
' 出力先を指定し、文書をPDFとして出力する為のオブジェクト
pw =
PdfWriter.GetInstance(
doc,
New FileStream(pdf, FileMode.Create)
)
' 出力開始
doc.Open()
pcb = pw.DirectContent
'フォント指定
' 日本語フォントの設定
font1 = New Font(
iTextSharp.text.pdf.BaseFont.CreateFont(
windir & "\Fonts\MSGOTHIC.TTC,0",
iTextSharp.text.pdf.BaseFont.IDENTITY_H,
iTextSharp.text.pdf.BaseFont.EMBEDDED), 10)
font2 = New Font(
iTextSharp.text.pdf.BaseFont.CreateFont(
windir & "\Fonts\MSGOTHIC.TTC,1",
iTextSharp.text.pdf.BaseFont.IDENTITY_H,
iTextSharp.text.pdf.BaseFont.EMBEDDED), 12, BOLD)
font3 = New Font(
iTextSharp.text.pdf.BaseFont.CreateFont(
windir & "\Fonts\MSMINCHO.TTC,0",
iTextSharp.text.pdf.BaseFont.IDENTITY_H,
iTextSharp.text.pdf.BaseFont.EMBEDDED), 10)
font4 = New Font(
iTextSharp.text.pdf.BaseFont.CreateFont(
windir & "\Fonts\MSMINCHO.TTC,1",
iTextSharp.text.pdf.BaseFont.IDENTITY_H,
iTextSharp.text.pdf.BaseFont.EMBEDDED), 12, BOLD, BlueColor)
'印刷開始
'データ獲得
Call docPdf_BeginPdf()
rowMax = 55
If TextBox3.Text = "横" Then
rowMax = 38
End If
pageCount = 1
prtRow = 0
Dim fst = 0
Dim y = 0
While rs.Read()
If fst = 0 Then
Header(pageCount)
fst = 1
End If
If prtRow > rowMax Then
pageCount += 1
Header(pageCount)
End If
Dim table = New PdfPTable(3)
Dim Width() As Integer = {3, 8, 3}
table.SetWidths(Width)
table.WidthPercentage = 100
'table.SpacingAfter = 14.0F
Dim cell = New PdfPCell(New Phrase(rs("取引先コード"), font3))
cell.BorderColor = BaseColor.BLACK
cell.BorderWidth = 0.2
cell.Border = Rectangle.BOX
'cell.BackgroundColor = BaseColor.CYAN
cell.HorizontalAlignment = 1 '1 Center 2 Right 0 Left
cell.FixedHeight = 14.2
cell.VerticalAlignment = Element.ALIGN_JUSTIFIED
table.AddCell(cell)
Dim cell2 = New PdfPCell(New Phrase(rs("取引先名"), font3))
cell2.BorderColor = BaseColor.BLACK
cell2.BorderWidth = 0.2
cell2.Border = Rectangle.BOX
'cell2.BackgroundColor = BaseColor.CYAN
cell2.HorizontalAlignment = 0
cell2.FixedHeight = 14.2
cell2.VerticalAlignment = Element.ALIGN_JUSTIFIED
table.AddCell(cell2)
Dim cell3 = New PdfPCell(New Phrase(rs("取引先区分"), font3))
cell3.BorderColor = BaseColor.BLACK
cell3.BorderWidth = 0.2
cell3.Border = Rectangle.BOX
'cell3.BackgroundColor = BaseColor.CYAN
cell3.HorizontalAlignment = 1
cell3.FixedHeight = 14.2
cell3.VerticalAlignment = Element.ALIGN_JUSTIFIED
table.AddCell(cell3)
doc.Add(table)
prtRow += 1
End While
' 出力終了
doc.Close()
'PDF を拡張子実行
'System.Diagnostics.Process.Start(pdf)
'接続解除
If Not co Is Nothing Then
co.Close()
End If
strUrl = pdf
Dim iform3 As New Form3
iform3.ShowDialog()
End Sub
Private Sub Header(page As Int16)
doc.NewPage()
'印刷処理実体の作成
'見出し項目
Dim strPage = "page." + Str(pageCount)
If TextBox3.Text = "縦" Then
SetCellText(pcb, 170, 810 + 14.4, 400, 810, "＊＊ 取引先マスター一覧表 ＊＊", font4, "C")
SetCellText(pcb, 520, 810 + 14.4, 585, 778, strPage, font4, "R")
Else
SetCellText(pcb, 170, 564 + 14.4, 400, 564, "＊＊ 取引先マスター一覧表 ＊＊", font4, "C")
SetCellText(pcb, 520, 564 + 14.4, 585, 532.8, strPage, font3, "R")
End If
'右上寄せの枠線なしの2カラムのテーブルを作成
Dim table = New PdfPTable(3)
table.WidthPercentage = 100
'table.SpacingAfter = 10.0F;
table.AddCell(New PdfPCell(New Phrase(" ", font3))).BorderWidth = 0
table.AddCell(New PdfPCell(New Phrase(" ", font3))).BorderWidth = 0
table.AddCell(New PdfPCell(New Phrase(" ", font3))).BorderWidth = 0
doc.Add(table)
table = New PdfPTable(3)
Dim Width() As Integer = {3, 8, 3}
table.SetWidths(Width)
table.WidthPercentage = 100
'table.SpacingAfter = 14.0F
'table.TotalWidth = 570.0
'table.LockedWidth = True
Dim cell = New PdfPCell(New Phrase("取引先コード", font3))
cell.FixedHeight = 14.4
cell.BorderColor = BaseColor.BLUE
cell.BorderWidth = 0.3
cell.Border = Rectangle.BOX
cell.BackgroundColor = BaseColor.CYAN
cell.HorizontalAlignment = 1 '1 Center 2 Right 3 Left
cell.VerticalAlignment = Element.ALIGN_JUSTIFIED_ALL
table.AddCell(cell)
Dim cell2 = New PdfPCell(New Phrase("取引先名", font3))
cell2.BorderColor = BaseColor.BLUE
cell2.BorderWidth = 0.3
cell2.Border = Rectangle.BOX
cell2.BackgroundColor = BaseColor.CYAN
cell2.HorizontalAlignment = 1
table.AddCell(cell2)
Dim cell3 = New PdfPCell(New Phrase("取引先区分", font3))
cell3.BorderColor = BaseColor.BLUE
cell3.BorderWidth = 0.3
cell3.Border = Rectangle.BOX
cell3.BackgroundColor = BaseColor.CYAN
cell3.HorizontalAlignment = 1
table.AddCell(cell3)
doc.Add(table)
'印字行数
prtRow = 4
End Sub
Private Sub 照会ToolStripMenuItem1_Click(sender As Object, e As EventArgs) Handles 照会ToolStripMenuItem1.Click
Dim iform3 As New Form3
iform3.ShowDialog()
End Sub
'
'Line
'
Private Sub Line(pcb As PdfContentByte,
ByVal x1 As Integer,
ByVal y1 As Integer,
ByVal x2 As Integer,
ByVal y2 As Integer, ByVal w As Long)
' 一番上のレイヤーに直線を引く
pcb.MoveTo(x1, y1)
pcb.LineTo(x2, y2)
pcb.SetLineWidth(w)
pcb.Stroke()
End Sub
'
'Box
'
Private Sub Box(pcb As PdfContentByte,
ByVal x1 As Integer,
ByVal y1 As Integer,
ByVal x2 As Integer,
ByVal y2 As Integer, ByVal w As Long)
' 一番上のレイヤーに直線を引く
pcb.MoveTo(x1, y1)
pcb.LineTo(x2, y1)
pcb.LineTo(x2, y2)
pcb.LineTo(x1, y2)
pcb.LineTo(x1, y1)
pcb.SetLineWidth(w)
pcb.Stroke()
End Sub
'
'Box Text( はみ出すと表示されない )
'
Public Sub SetCellText(pcb As PdfContentByte,
ByVal x1 As Integer,
ByVal y1 As Integer,
ByVal x2 As Integer,
ByVal y2 As Integer,
ByVal text As String,
ByVal font As Font,
ByVal alignment As String)
'SetSimpleColumn(
' Phrase phrase, // コラムに設定するテキストを保持する Phrase オブジェクト
' float llx, // 矩形の左下隅の X 座標
' float lly, // 同、Y 座標
' float urx, // 右上隅の X 座標
' float ury, // 同、Y 座標
' float leading, // レディング量
' int alignment // 整列方法
');
Dim ct As ColumnText = New ColumnText(pcb)
Dim myText As Phrase = Nothing
Dim offy As Double
If font.Size = -1 Then
offy = 12
Else
offy = font.Size
End If
myText = New Phrase(text, font)
If alignment = "R" Or alignment = "r" Then
ct.SetSimpleColumn(
myText,
x1, y1 - offy,
x2, y2 - offy,
0,
Element.ALIGN_RIGHT
)
ElseIf alignment = "C" Or alignment = "C" Then
ct.SetSimpleColumn(
myText,
x1, y1 - offy,
x2, y2 - offy,
0,
Element.ALIGN_CENTER
)
ElseIf alignment = "J" Or alignment = "j" Then
ct.SetSimpleColumn(
myText,
x1, y1 - offy,
x2, y2 - offy,
0,
Element.ALIGN_JUSTIFIED_ALL
)
Else
ct.SetSimpleColumn(
myText,
x1, y1 - offy,
x2, y2 - offy,
0,
Element.ALIGN_LEFT
)
End If
ct.Go()
End Sub
End Class
Form2.vb
Public Class Form2
Private Sub Form2_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim stCurrentDir As String = System.IO.Directory.GetCurrentDirectory()
Dim n2 As Integer = FreeFile()
Dim st As String
Me.KeyPreview = True
Try
n = FreeFile()
FileOpen(n, stCurrentDir & "\PARA.ini", OpenMode.Input)
TextBox1.Text = LineInput(n)
TextBox2.Text = LineInput(n)
TextBox3.Text = LineInput(n)
TextBox4.Text = LineInput(n)
TextBox5.Text = LineInput(n)
TextBox6.Text = LineInput(n)
TextBox7.Text = LineInput(n)
FileClose(n)
Catch
FileOpen(n2, stCurrentDir & "\PARA.ini", OpenMode.Output)
st = ""
PrintLine(n2, st)
PrintLine(n2, st)
PrintLine(n2, st)
PrintLine(n2, st)
PrintLine(n2, st)
PrintLine(n2, st)
PrintLine(n2, st)
FileClose(n2)
End Try
ComboBox1.Items.Clear()
Dim PrinterName As String
For Each PrinterName _
In Printing.PrinterSettings.InstalledPrinters
ComboBox1.Items.Add(PrinterName)
Next
End Sub
'-------------------------------------------------------
'プリンター名コンボ処理
'-------------------------------------------------------
Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged
TextBox6.Text = ComboBox1.Text
End Sub
'-------------------------------------------------------
'登録ボタン処理
'-------------------------------------------------------
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim stCurrentDir As String = System.IO.Directory.GetCurrentDirectory()
Dim n2 As Integer = FreeFile()
Dim st As String
FileOpen(n2, stCurrentDir & "\PARA.ini", OpenMode.Output)
st = TextBox1.Text
PrintLine(n2, st)
st = TextBox2.Text
PrintLine(n2, st)
st = TextBox3.Text
PrintLine(n2, st)
st = TextBox4.Text
PrintLine(n2, st)
st = TextBox5.Text
PrintLine(n2, st)
st = TextBox6.Text
PrintLine(n2, st)
st = TextBox7.Text
PrintLine(n2, st)
FileClose(n2)
SYSTEM_NAME = TextBox1.Text
USER_NAME = TextBox2.Text
PASSWORD = TextBox3.Text
SERVER = TextBox4.Text
LIBL = TextBox5.Text
prtName = TextBox6.Text
OutDir = TextBox7.Text + "\"
CoString = "Provider=SQLOLEDB.1;Data Source=" & SYSTEM_NAME _
& ";Initial Catalog=" & LIBL _
& ";Password=" & PASSWORD & ";User ID=" & USER_NAME & ";"
End Sub
'-------------------------------------------------------
'終了ボタン処理
'-------------------------------------------------------
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Me.Close()
End Sub
'-------------------------------------------------------
'keyDown処理
'-------------------------------------------------------
Private Sub Form2_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
If e.KeyCode = Keys.End Then
Me.Close()
End If
End Sub
'-------------------------------------------------------
'keyPress処理
'-------------------------------------------------------
Private Sub Form2_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles MyBase.KeyPress
If e.KeyChar = Chr(13) Then
SendKeys.Send("{TAB}")
e.Handled = True
End If
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
'FolderBrowserDialogクラスのインスタンスを作成
Dim fbd As New FolderBrowserDialog
'上部に表示する説明テキストを指定する
fbd.Description = "フォルダを指定してください。"
'ルートフォルダを指定する
'デフォルトでDesktop
fbd.RootFolder = Environment.SpecialFolder.Desktop
'最初に選択するフォルダを指定する
'RootFolder以下にあるフォルダである必要がある
fbd.SelectedPath = "C:\Windows"
'ユーザーが新しいフォルダを作成できるようにする
'デフォルトでTrue
fbd.ShowNewFolderButton = True
'ダイアログを表示する
If fbd.ShowDialog(Me) = DialogResult.OK Then
'選択されたフォルダを表示する
TextBox7.Text = fbd.SelectedPath
End If
End Sub
End ClassForm3.vb
'-------------------------------------------------------
' フォーム初期処理
'-------------------------------------------------------
Imports System.Security.Cryptography
Public Class Form3
Private Sub Form3_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.KeyPreview = True
If Len(strUrl) > 0 Then
Me.WebView21.Source = New Uri(strUrl)
End If
End Sub
'-------------------------------------------------------
' keyDown処理 Endボタンで終了
'-------------------------------------------------------
Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
If e.KeyCode = Keys.End Then
Me.Close()
End If
End Sub
'-------------------------------------------------------
' keyPress処理 Enter = tab
'-------------------------------------------------------
Private Sub Form1_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles MyBase.KeyPress
If e.KeyChar = Chr(13) Then
SendKeys.Send("{TAB}")
e.Handled = True
End If
End Sub
'-------------------------------------------------------
' Textbox1 KeyDown処理
'-------------------------------------------------------
Private Sub TextBox1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles TextBox1.KeyDown
If e.KeyCode = Keys.Enter And TextBox1.Text IsNot String.Empty Then
Me.WebView21.Source = New Uri(TextBox1.Text)
End If
End Sub
'-------------------------------------------------------
' 終了ボタン処理
'-------------------------------------------------------
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Me.Close()
End Sub
'-------------------------------------------------------
' 参照ボタン処理
'-------------------------------------------------------
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim ofd As OpenFileDialog = New OpenFileDialog()
ofd.InitialDirectory = OutDir
ofd.Filter = "PDFファイル(*.pdf)|*.pdf"
If ofd.ShowDialog() = DialogResult.OK Then
WebView21.Source = New Uri(ofd.FileName)
TextBox1.Text = ofd.FileName
End If
End Sub
'-------------------------------------------------------
' << Pre ボタン処理
'-------------------------------------------------------
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
If WebView21.CanGoBack Then
WebView21.GoBack()
End If
End Sub
'-------------------------------------------------------
' Next >> ボタン処理
'-------------------------------------------------------
Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
If WebView21.CanGoForward Then
WebView21.GoForward()
End If
End Sub
'-------------------------------------------------------
' Web Change 処理
'-------------------------------------------------------
Private Sub webView21_SourceChanged(sender As Object, e As Microsoft.Web.WebView2.Core.CoreWebView2SourceChangedEventArgs) Handles WebView21.SourceChanged
Button3.Enabled = WebView21.CanGoBack
Button4.Enabled = WebView21.CanGoForward
TextBox1.Text = WebView21.Source.ToString()
End Sub
End Classmodule1.vb
Module Module1
Public F1 As Form1
Public fname As System.IO.StreamReader
Public SYSTEM_NAME As String
Public USER_NAME As String
Public PASSWORD As String
Public SERVER As String
Public LIBL As String
Public prtName As String
Public OutDir As String
Public F2Str As String
Public strUrl As String
Public n As Integer = FreeFile()
Public CoString As String
Public Sub INI()
Try
Dim stCurrentDir As String = System.IO.Directory.GetCurrentDirectory()
n = FreeFile()
FileOpen(n, stCurrentDir & "\PARA.ini", OpenMode.Input)
SYSTEM_NAME = LineInput(n)
USER_NAME = LineInput(n)
PASSWORD = LineInput(n)
SERVER = LineInput(n)
LIBL = LineInput(n)
prtName = LineInput(n)
OutDir = LineInput(n) + "\"
FileClose(n)
Catch
MsgBox("設定ファイルエラー:エラーＮＯ:" &
Err.Number & vbCr & Err.Description & vbCr &
"設定してください。")
End Try
CoString = "Provider=SQLOLEDB.1;Data Source=" & SYSTEM_NAME _
& ";Initial Catalog=" & LIBL _
& ";Password=" & PASSWORD & ";User ID=" & USER_NAME & ";"
End Sub
End Module
clsResize.vb
Imports System
Imports System.Collections.Generic
Imports System.Linq
Imports System.Text
Imports System.Windows.Forms
Public Class clsResize
Private _arr_control_storage As List(Of System.Drawing.Rectangle) = New List(Of System.Drawing.Rectangle)()
Private showRowHeader As Boolean = False
Private FontTable As Dictionary(Of String, Single)
Private ControlTable As Dictionary(Of String, System.Drawing.Rectangle)
Public Sub New(ByVal _form_ As Form)
form = _form_
_formSize = _form_.ClientSize
_fontsize = _form_.Font.Size
Dim _controls = _get_all_controls(form)
FontTable = New Dictionary(Of String, Single)()
ControlTable = New Dictionary(Of String, System.Drawing.Rectangle)()
For Each control As Control In _controls
FontTable.Add(control.Name, control.Font.Size)
ControlTable.Add(control.Name, control.Bounds)
Next
End Sub
Private _fontsize As Single
Private _formSize As System.Drawing.SizeF
Private form As Form
Public Sub _get_initial_size()
Dim _controls = _get_all_controls(form)
For Each control As Control In _controls
_arr_control_storage.Add(control.Bounds)
If control.[GetType]() = GetType(DataGridView) Then _dgv_Column_Adjust((CType(control, DataGridView)), showRowHeader)
Next
End Sub
Public Sub _resize()
Dim _form_ratio_width As Double = CDbl(form.ClientSize.Width) / CDbl(_formSize.Width)
Dim _form_ratio_height As Double = CDbl(form.ClientSize.Height) / CDbl(_formSize.Height)
Dim _controls = _get_all_controls(form)
Dim _pos As Integer = -1
For Each control As Control In _controls
Me._fontsize = FontTable(control.Name)
_pos += 1
Dim _controlSize As System.Drawing.Size = New System.Drawing.Size(CInt((_arr_control_storage(_pos).Width * _form_ratio_width)), CInt((_arr_control_storage(_pos).Height * _form_ratio_height)))
Dim _controlposition As System.Drawing.Point = New System.Drawing.Point(CInt((_arr_control_storage(_pos).X * _form_ratio_width)), CInt((_arr_control_storage(_pos).Y * _form_ratio_height)))
control.Bounds = New System.Drawing.Rectangle(_controlposition, _controlSize)
If control.[GetType]() = GetType(DataGridView) Then _dgv_Column_Adjust((CType(control, DataGridView)), showRowHeader)
control.Font = New System.Drawing.Font(form.Font.FontFamily, CSng((((Convert.ToDouble(_fontsize) * _form_ratio_width) / 2) + ((Convert.ToDouble(_fontsize) * _form_ratio_height) / 2))))
Next
End Sub
Private Sub _dgv_Column_Adjust(ByVal dgv As DataGridView, ByVal _showRowHeader As Boolean)
Dim intRowHeader As Integer = 0
Const Hscrollbarwidth As Integer = 5
If _showRowHeader Then
intRowHeader = dgv.RowHeadersWidth
Else
dgv.RowHeadersVisible = False
End If
For i As Integer = 0 To dgv.ColumnCount - 1
If dgv.Dock = DockStyle.Fill Then
dgv.Columns(i).Width = ((dgv.Width - intRowHeader) / dgv.ColumnCount)
Else
dgv.Columns(i).Width = ((dgv.Width - intRowHeader - Hscrollbarwidth) / dgv.ColumnCount)
End If
Next
End Sub
Private Shared Function _get_all_controls(ByVal c As Control) As IEnumerable(Of Control)
Return c.Controls.Cast(Of Control)().SelectMany(Function(item) _get_all_controls(item)).Concat(c.Controls.Cast(Of Control)()).Where(Function(control) control.Name <> String.Empty)
End Function
End Class
Baseform.vb
Public Class BaseForm
Private resizeHelper As clsResize
Public Sub New()
InitializeComponent()
OnLoad(EventArgs.Empty)
End Sub
Protected Overrides Sub OnLoad(e As EventArgs)
If Not DesignMode Then
MyBase.OnLoad(e)
resizeHelper = New clsResize(Me)
resizeHelper._get_initial_size()
End If
End Sub
Protected Overrides Sub OnResize(e As EventArgs)
If Not DesignMode Then
If resizeHelper Is Nothing Then
resizeHelper = New clsResize(Me)
resizeHelper._get_initial_size()
Else
resizeHelper._resize()
End If
End If
End Sub
End Class
Form1.Designer.vb
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Class Form1
'Inherits System.Windows.Forms.Form
Inherits BaseForm
'フォームがコンポーネントの一覧をクリーンアップするために dispose をオーバーライドします。
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
'Windows フォーム デザイナーで必要です。
Private components As System.ComponentModel.IContainer