Orator's IO

Imports Excel = Microsoft.Office.Interop.Excel
Imports System.Runtime.InteropServices
Public Class Form1
  Private WithEvents xlApp As Excel.Application

  Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
    If xlApp IsNot Nothing Then
      'xlApp.Quit()
      If Marshal.IsComObject(xlApp) Then
        Marshal.ReleaseComObject(xlApp)
      End If
      xlApp = Nothing    '★
    End If
  End Sub

  Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
    xlApp = New Excel.ApplicationClass()
    xlApp.Visible = True
  End Sub

  Private Sub xlApp_NewWorkbook(Wb As Excel.Workbook) Handles xlApp.NewWorkbook
    MsgBox("新しいブック")
  End Sub
End Class

Private Sub xlApp_NewWorkbook(Wb As Excel.Workbook)  'Handles xlApp.NewWorkbook
  MsgBox("新しいブック")
End Sub

'Private WithEvents xlApp As Excel.Application
Private xlApp As Excel.Application
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
    xlApp = New Excel.ApplicationClass()
    AddHandler xlApp.NewWorkbook, AddressOf xlApp_NewWorkbook    
    xlApp.Visible = True
End Sub

Partial Public Class Form1
	Public Class SampleGrid
		Inherits AxMSHierarchicalFlexGridLib.AxMSHFlexGrid
		Public Shadows Event MouseWheel As MouseEventHandler
		Protected Overrides Sub OnMouseWheel(ByVal e As MouseEventArgs)
			RaiseEvent MouseWheel(Me, e)
			MyBase.OnMouseWheel(e)
		End Sub
	End Class

	Private WithEvents AxMSHFlexGrid1 As SampleGrid
	Private Sub Form1_Load(ByVal sender As System.Object, _
	  ByVal e As System.EventArgs) Handles MyBase.Load
		AxMSHFlexGrid1 = New SampleGrid()
		AxMSHFlexGrid1.Dock = DockStyle.Fill
		Controls.Add(AxMSHFlexGrid1)

		FillSampleData(AxMSHFlexGrid1)
	End Sub

	Private Sub AxMSHFlexGrid1_MouseWheel(ByVal sender As Object, _
	  ByVal e As MouseEventArgs) Handles AxMSHFlexGrid1.MouseWheel
		Dim row As Integer = AxMSHFlexGrid1.TopRow - _
			(e.Delta \ SystemInformation.MouseWheelScrollDelta)
		If row < AxMSHFlexGrid1.FixedRows Then
			row = AxMSHFlexGrid1.FixedRows
		ElseIf row > AxMSHFlexGrid1.Rows - 1 Then
			row = AxMSHFlexGrid1.Rows - 1
		End If
		AxMSHFlexGrid1.TopRow = row
	End Sub

	Private Shared Sub FillSampleData( _
	  ByVal grid As AxMSHierarchicalFlexGridLib.AxMSHFlexGrid)
		With grid
			.Rows = 200
			'.Cols = 20
			.set_Cols(20)
			Dim Cells As New System.Text.StringBuilder()
			For row As Integer = 0 To 199
				For col As Integer = 0 To 19
					Cells.Append(String.Format("{0,3}-{1,3}", row, col))
					Cells.Append(vbTab)
				Next
				Cells.AppendLine()
			Next
			.Row = 0
			.Col = 0
			.RowSel = 199
			.ColSel = 19
			.Clip = Cells.ToString()
			.RowSel = 0
			.ColSel = 0
		End With
	End Sub
End Class

Dim ArrayName As String = "Test"
Dim ArrayMaxIndex1 As Integer = 3
Dim ArrayMaxIndex2 As Integer = 2

Dim arrayInstance As New CodeMethodInvokeExpression( _
	New CodeTypeReferenceExpression(GetType(Array)), "CreateInstance", _
	New CodeTypeOfExpression(New CodeTypeReference(GetType(Integer))), _
	New CodePrimitiveExpression(ArrayMaxIndex1 + 1), _
	New CodePrimitiveExpression(ArrayMaxIndex2 + 1))

Dim variable As New CodeVariableDeclarationStatement( _
	GetType(Integer(,)), ArrayName, _
	New CodeCastExpression(GetType(Integer(,)), arrayInstance))

Dim statements As New CodeStatementCollection()
statements.Add(New CodeCommentStatement(String.Format("配列{0}の宣言", ArrayName)))
statements.Add(variable)

Using sw As New StringWriter()
	For Each language As String In "C#,VisualBasic,JScript,VJ#,C++".Split(",")
		Dim provider As CodeDomProvider = Nothing
		Try
			provider = CodeDomProvider.CreateProvider(language)
			If Not provider.Supports(GeneratorSupport.MultidimensionalArrays) Then
				sw.WriteLine("★{0} は多次元配列をサポートしていません。", language)
			End If
			sw.WriteLine("☆{0} として生成されたコード", language)
		Catch ex As Exception
			sw.WriteLine("★{0} のコードは生成できません。", language)
			sw.WriteLine()
			Continue For
		End Try
		For Each s As CodeStatement In statements
			provider.GenerateCodeFromStatement(s, sw, Nothing)
		Next
		sw.WriteLine()
	Next

	Dim GeneratedSource As String = sw.ToString()
	Clipboard.SetText(GeneratedSource)
	TextBox1.Text = GeneratedSource
End Using

DateTimePicker1.MaxDate = #12/31/9998 23:59:59#

DateTimePicker1.MaxDate = #12/31/9998 00:00:00#  'OK

Dim dt As Date '= DateTimePicker.MaximumDateTime
dt = Date.MaxValue
DateTimePicker1.MaxDate = dt            'OK
DateTimePicker1.MaxDate = DateTime.Now  'OK
DateTimePicker1.MaxDate = dt            '例外

Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
	Me.Button1.Text = "変換"
	Me.TextBox1.Text = "#789"
End Sub

Private Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
	Me.Text = ToColorName(Me.TextBox1.Text)
End Sub

'『Imports System.Drawing, System.Reflection』が必要です。
Public Shared Function ToColorName(ByVal htmlColor As String) As String
	Dim colorName As String = htmlColor
	Dim C As Color
	Dim _htmlColor As Color = FromHtmlColor(htmlColor)
	For Each P As PropertyInfo In GetType(Color).GetProperties(BindingFlags.IgnoreCase Or BindingFlags.GetProperty Or BindingFlags.Static Or BindingFlags.Public)
		'If _htmlColor.Equals(P.GetValue(C, Nothing)) Then
		If _htmlColor.ToArgb() = DirectCast(P.GetValue(C, Nothing), Color).ToArgb() Then
			colorName = P.Name
			Exit For
		End If
	Next
	Return colorName
End Function

Private Shared Function FromHtmlColor(ByVal htmlColor As String) As Color
	Dim _color As Color = Color.Empty
	If Len(htmlColor) > 0 Then
		If (htmlColor.Chars(0) = "#"c) AndAlso ((htmlColor.Length = 7) OrElse (htmlColor.Length = 4)) Then
			If htmlColor.Length = 7 Then
				_color = Color.FromArgb(Convert.ToInt32(htmlColor.Substring(1, 2), 16), Convert.ToInt32(htmlColor.Substring(3, 2), 16), Convert.ToInt32(htmlColor.Substring(5, 2), 16))
			Else
				_color = Color.FromArgb(Convert.ToInt32(New String(htmlColor.Chars(1), 2), 16), Convert.ToInt32(New String(htmlColor.Chars(2), 2), 16), Convert.ToInt32(New String(htmlColor.Chars(3), 2), 16))
			End If
		End If
	End If
	Return _color
End Function

'『Imports System.Drawing, System.Reflection』が必要です。
Public Shared Function GetColorFromName(ByVal Name As String) As Color
	Dim C As Color
	Dim P As PropertyInfo
	P = GetType(SystemColors).GetProperty(Name, BindingFlags.IgnoreCase Or BindingFlags.GetProperty Or BindingFlags.Static Or BindingFlags.Public)
	If Not P Is Nothing Then
		Return CType(P.GetValue(C, Nothing), Color)
	End If
	P = GetType(Color).GetProperty(Name, BindingFlags.IgnoreCase Or BindingFlags.GetProperty Or BindingFlags.Static Or BindingFlags.Public)
	If Not P Is Nothing Then
		Return CType(P.GetValue(C, Nothing), Color)
	End If
	Return Color.Empty
End Function