Windowsのプロセスをkillするバッチ
登録してある特定のプロセスをkillするバッチファイル
使い方
- バッチファイルの中身は以下のソースをコピーします
- バッチファイルと同じディレクトリにkill.iniというファイルを作ります
- kill.iniにはキルしたいプロセス名を一行ずつに記載
- 例えばnotepad.exeみたいなのを一行ずつ書いていく
あとはバッチファイルを実行すればok
ソース
@echo off FOR /F "delims=" %%a IN (kill.ini) DO ( taskkill /im %%a /F /T )
セグ16っぽいのを表示するプログラム
セグ16を表示するためのディスプレイを作りました。セグ16についてはこちらを参考。【武蔵野電波のプロトタイパーズ】第4回「16セグメントLEDを使ってみよう」 - PC Watch。それっぽい感じのを作っただけなので、実装は適当です。
このプログラムは列挙体としてセグメントの各ピンを定義して、この列挙体を複合フラグとして扱います。
セグメントの定義
<Flags()> _ Public Enum Segment None = 0 A1 = 1 M2 = 2 K3 = 4 H4 = 8 U5 = 16 S6 = 32 T7 = 64 G8 = 128 F9 = 256 E10 = 512 DP12 = 1024 D13 = 2048 R14 = 4096 P15 = 8192 C16 = 16384 N17 = 32768 B18 = 65536 End Enum
文字の定義
Dictionaryで文字と複合フラグを関連付けます
Public Class SegmentDictionary Inherits Dictionary(Of String, Segment) Sub New() Dim topHorizonLine As Segment = ConnectSeg(Segment.A1, Segment.B18) Dim centerHorizonLine As Segment = ConnectSeg(Segment.U5, Segment.P15) Dim bottomHorizonLine As Segment = ConnectSeg(Segment.F9, Segment.E10) Dim leftVerticalLine As Segment = ConnectSeg(Segment.H4, Segment.G8) Dim centerVerticalLine As Segment = ConnectSeg(Segment.M2, Segment.S6) Dim rightVerticalLine As Segment = ConnectSeg(Segment.C16, Segment.D13) Dim slashLeftTopRightBottom As Segment = ConnectSeg(Segment.K3, Segment.R14) Dim slashRightTopLeftBottom As Segment = ConnectSeg(Segment.N17, Segment.T7) Dim leftTopBox As Segment = ConnectSeg(Segment.A1, Segment.H4, Segment.U5, Segment.M2) Dim leftDownBox As Segment = ConnectSeg(Segment.U5, Segment.G8, Segment.F9, Segment.S6) Dim rightTopBox As Segment = ConnectSeg(Segment.B18, Segment.C16, Segment.P15, Segment.M2) Dim rightDownBox As Segment = ConnectSeg(Segment.P15, Segment.D13, Segment.E10, Segment.S6) Dim topBox As Segment = ConnectSeg(topHorizonLine, Segment.C16, centerHorizonLine, Segment.H4) Dim downBox As Segment = ConnectSeg(bottomHorizonLine, Segment.G8, centerHorizonLine, Segment.D13) Dim zero As Segment = ConnectSeg(topHorizonLine, bottomHorizonLine, leftVerticalLine, rightVerticalLine) Dim one As Segment = centerVerticalLine Dim two As Segment = ConnectSeg(topHorizonLine, Segment.C16, centerHorizonLine, Segment.G8, bottomHorizonLine) Dim three As Segment = ConnectSeg(topHorizonLine, centerHorizonLine, bottomHorizonLine, rightVerticalLine) Dim four As Segment = ConnectSeg(Segment.H4, centerHorizonLine, rightVerticalLine) Dim five As Segment = ConnectSeg(topHorizonLine, Segment.H4, centerHorizonLine, Segment.D13, bottomHorizonLine) Dim six As Segment = ConnectSeg(topHorizonLine, Segment.H4, downBox) Dim seven As Segment = ConnectSeg(rightVerticalLine, Segment.H4, topHorizonLine) Dim eight As Segment = ConnectSeg(topHorizonLine, centerHorizonLine, bottomHorizonLine, leftVerticalLine, rightVerticalLine) Dim nine As Segment = ConnectSeg(rightVerticalLine, topHorizonLine, Segment.H4, centerHorizonLine) Dim dot As Segment = Segment.DP12 Dim none As Segment = Segment.None Dim smallA As Segment = ConnectSeg(Segment.B18, Segment.C16, rightDownBox) Dim smallB As Segment = ConnectSeg(Segment.M2, rightDownBox) Dim smallC As Segment = ConnectSeg(Segment.P15, Segment.S6, Segment.E10) Dim smallD As Segment = ConnectSeg(Segment.P15, Segment.E10, Segment.S6, rightVerticalLine) Dim smallE As Segment = ConnectSeg(rightTopBox, Segment.S6, Segment.E10) Dim smallF As Segment = ConnectSeg(centerVerticalLine, centerHorizonLine, Segment.B18) Dim smallG As Segment = ConnectSeg(rightTopBox, Segment.D13, Segment.E10) Dim smallH As Segment = ConnectSeg(centerVerticalLine, Segment.P15, Segment.D13) Dim smallI As Segment = ConnectSeg(Segment.S6) Dim smallJ As Segment = ConnectSeg(Segment.E10, rightVerticalLine) Dim smallK As Segment = ConnectSeg(centerVerticalLine, Segment.N17, Segment.R14) Dim smallL As Segment = ConnectSeg(centerVerticalLine) Dim smallM As Segment = ConnectSeg(Segment.G8, centerHorizonLine, Segment.S6, Segment.D13) Dim smallN As Segment = ConnectSeg(Segment.S6, Segment.P15, Segment.D13) Dim smallO As Segment = ConnectSeg(rightDownBox) Dim smallP As Segment = ConnectSeg(rightTopBox, Segment.S6) Dim smallQ As Segment = ConnectSeg(rightTopBox, Segment.D13) Dim smallR As Segment = ConnectSeg(centerVerticalLine, Segment.N17) Dim smallS As Segment = ConnectSeg(Segment.B18, Segment.M2, Segment.P15, Segment.D13, Segment.E10) Dim smallT As Segment = ConnectSeg(centerHorizonLine, centerVerticalLine) Dim smallU As Segment = ConnectSeg(Segment.S6, Segment.E10, Segment.D13) Dim smallV As Segment = ConnectSeg(Segment.D13, Segment.R14) Dim smallW As Segment = ConnectSeg(Segment.G8, Segment.T7, Segment.R14, Segment.D13) Dim smallX As Segment = ConnectSeg(slashLeftTopRightBottom, slashRightTopLeftBottom) Dim smallY As Segment = ConnectSeg(Segment.K3, slashRightTopLeftBottom) Dim smallZ As Segment = ConnectSeg(Segment.U5, Segment.T7, Segment.F9) Dim bigA As Segment = ConnectSeg(topBox, Segment.G8, Segment.D13) Dim bigB As Segment = ConnectSeg(leftTopBox, downBox) Dim bigC As Segment = ConnectSeg(topHorizonLine, leftVerticalLine, bottomHorizonLine) Dim bigD As Segment = ConnectSeg(topHorizonLine, rightVerticalLine, bottomHorizonLine, leftVerticalLine) Dim bigE As Segment = ConnectSeg(topHorizonLine, centerHorizonLine, bottomHorizonLine, leftVerticalLine) Dim bigF As Segment = ConnectSeg(topHorizonLine, centerHorizonLine, leftVerticalLine) Dim bigG As Segment = ConnectSeg(topHorizonLine, bottomHorizonLine, leftVerticalLine, Segment.P15, Segment.D13) Dim bigH As Segment = ConnectSeg(leftVerticalLine, rightVerticalLine, centerHorizonLine) Dim bigI As Segment = ConnectSeg(topHorizonLine, centerVerticalLine, bottomHorizonLine) Dim bigJ As Segment = ConnectSeg(topHorizonLine, centerVerticalLine, Segment.F9) Dim bigK As Segment = ConnectSeg(centerVerticalLine, Segment.N17, Segment.R14) Dim bigL As Segment = ConnectSeg(leftVerticalLine, bottomHorizonLine) Dim bigM As Segment = ConnectSeg(leftVerticalLine, Segment.K3, Segment.N17, rightVerticalLine) Dim bigN As Segment = ConnectSeg(leftVerticalLine, slashLeftTopRightBottom, rightVerticalLine) Dim bigO As Segment = ConnectSeg(topHorizonLine, bottomHorizonLine, leftVerticalLine, rightVerticalLine) Dim bigP As Segment = ConnectSeg(topBox, Segment.G8) Dim bigQ As Segment = ConnectSeg(topHorizonLine, bottomHorizonLine, leftVerticalLine, rightVerticalLine, Segment.R14) Dim bigR As Segment = ConnectSeg(topBox, Segment.G8, Segment.R14) Dim bigS As Segment = ConnectSeg(topHorizonLine, centerHorizonLine, bottomHorizonLine, Segment.H4, Segment.D13) Dim bigT As Segment = ConnectSeg(topHorizonLine, centerVerticalLine) Dim bigU As Segment = ConnectSeg(leftVerticalLine, rightVerticalLine, bottomHorizonLine) Dim bigV As Segment = ConnectSeg(leftVerticalLine, slashRightTopLeftBottom) Dim bigW As Segment = ConnectSeg(leftVerticalLine, rightVerticalLine, Segment.T7, Segment.R14) Dim bigX As Segment = ConnectSeg(slashLeftTopRightBottom, slashRightTopLeftBottom) Dim bigY As Segment = ConnectSeg(Segment.K3, Segment.N17, Segment.S6) Dim bigZ As Segment = ConnectSeg(topHorizonLine, bottomHorizonLine, slashRightTopLeftBottom) Me.Add("", none) Me.Add("0", zero) Me.Add("1", one) Me.Add("2", two) Me.Add("3", three) Me.Add("4", four) Me.Add("5", five) Me.Add("6", six) Me.Add("7", seven) Me.Add("8", eight) Me.Add("9", nine) Me.Add("a", smallA) Me.Add("b", smallB) Me.Add("c", smallC) Me.Add("d", smallD) Me.Add("e", smallE) Me.Add("f", smallF) Me.Add("g", smallG) Me.Add("h", smallH) Me.Add("i", smallI) Me.Add("j", smallJ) Me.Add("k", smallK) Me.Add("l", smallL) Me.Add("m", smallM) Me.Add("n", smallN) Me.Add("o", smallO) Me.Add("p", smallP) Me.Add("q", smallQ) Me.Add("r", smallR) Me.Add("s", smallS) Me.Add("t", smallT) Me.Add("u", smallU) Me.Add("v", smallV) Me.Add("w", smallW) Me.Add("x", smallX) Me.Add("y", smallY) Me.Add("z", smallZ) Me.Add("A", bigA) Me.Add("B", bigB) Me.Add("C", bigC) Me.Add("D", bigD) Me.Add("E", bigE) Me.Add("F", bigF) Me.Add("G", bigG) Me.Add("H", bigH) Me.Add("I", bigI) Me.Add("J", bigJ) Me.Add("K", bigK) Me.Add("L", bigL) Me.Add("M", bigM) Me.Add("N", bigN) Me.Add("O", bigO) Me.Add("P", bigP) Me.Add("Q", bigQ) Me.Add("R", bigR) Me.Add("S", bigS) Me.Add("T", bigT) Me.Add("U", bigU) Me.Add("V", bigV) Me.Add("W", bigW) Me.Add("X", bigX) Me.Add("Y", bigY) Me.Add("Z", bigZ) End Sub Private Function ConnectSeg(ByVal sourceSeg As Segment, ByVal ParamArray targetSegArr() As Segment) As Segment Dim resultSeg As Segment = sourceSeg If targetSegArr Is Nothing Then Return resultSeg For Each targetSeg As Segment In targetSegArr resultSeg = resultSeg Or targetSeg Next Return resultSeg End Function End Class
表示するためのユーザーコントロール
このユーザーコントロールにはPictureBoxをPictureBox1という名前で配置します。セグメントを表示するためのメソッドとして、DisplaySegmentとDisplayStringという2つのメソッドを外部に公開しています。
Imports System.Windows.Forms Public Class Seg16Control #Region "Variables" Private _segWidth As Integer Private _segHeight As Integer Private _padding As Integer Private _segmentBold As Integer Private _leftTop As Point Private _centerTop As Point Private _rightTop As Point Private _leftCenter As Point Private _center As Point Private _rightCenter As Point Private _leftDown As Point Private _centerDown As Point Private _rightDown As Point Private _displayString As String Private _dicSegAction As Dictionary(Of Segment, Action(Of Graphics, Boolean)) Private _dicSegDisplay As Dictionary(Of String, Segment) #End Region #Region "Properties" #End Region #Region "Initialize" Sub New() ' この呼び出しはデザイナーで必要です。 InitializeComponent() ' InitializeComponent() 呼び出しの後で初期化を追加します。 InitializeDictionarySeg() _dicSegDisplay = New SegmentDictionary End Sub Private Sub PictureBox1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint InitializePosition() End Sub Private Sub InitializePosition() _segWidth = Me.Width _segHeight = Me.Height _padding = CInt(_segWidth / 5) _segmentBold = CInt(_padding / 4) Dim leftX As Integer = _padding Dim centerX As Integer = CInt(_segWidth / 2) Dim rightX As Integer = _segWidth - _padding Dim topY As Integer = _padding Dim centeY As Integer = CInt(_segHeight / 2) Dim downY As Integer = _segHeight - _padding _leftTop = New Point(leftX, topY) _centerTop = New Point(centerX, topY) _rightTop = New Point(rightX, topY) _leftCenter = New Point(leftX, centeY) _center = New Point(centerX, centeY) _rightCenter = New Point(rightX, centeY) _leftDown = New Point(leftX, downY) _centerDown = New Point(centerX, downY) _rightDown = New Point(rightX, downY) End Sub Private Sub InitializeDictionarySeg() _dicSegAction = New Dictionary(Of Segment, Action(Of Graphics, Boolean)) _dicSegAction.Add(Segment.A1, AddressOf DrawSeg1a) _dicSegAction.Add(Segment.M2, AddressOf DrawSeg2m) _dicSegAction.Add(Segment.K3, AddressOf DrawSeg3k) _dicSegAction.Add(Segment.H4, AddressOf DrawSeg4h) _dicSegAction.Add(Segment.U5, AddressOf DrawSeg5u) _dicSegAction.Add(Segment.S6, AddressOf DrawSeg6s) _dicSegAction.Add(Segment.T7, AddressOf DrawSeg7t) _dicSegAction.Add(Segment.G8, AddressOf DrawSeg8g) _dicSegAction.Add(Segment.F9, AddressOf DrawSeg9f) _dicSegAction.Add(Segment.E10, AddressOf DrawSeg10e) _dicSegAction.Add(Segment.DP12, AddressOf DrawSeg12) _dicSegAction.Add(Segment.D13, AddressOf DrawSeg13d) _dicSegAction.Add(Segment.R14, AddressOf DrawSeg14r) _dicSegAction.Add(Segment.P15, AddressOf DrawSeg15p) _dicSegAction.Add(Segment.C16, AddressOf DrawSeg16c) _dicSegAction.Add(Segment.N17, AddressOf DrawSeg17n) _dicSegAction.Add(Segment.B18, AddressOf DrawSeg18b) End Sub #End Region #Region "Display Methods" ''' <summary> ''' 指定された文字を表示 ''' </summary> ''' <param name="str"></param> ''' <remarks></remarks> Public Sub DisplayString(ByVal str As String) If str Is Nothing Then Throw New ArgumentNullException("str") If Me._dicSegDisplay.ContainsKey(str) Then DisplaySegment(Me._dicSegDisplay(str)) End If End Sub ''' <summary> ''' 指定されたセグメントを表示 ''' </summary> ''' <param name="selectSegment"></param> ''' <remarks></remarks> Public Sub DisplaySegment(ByVal selectSegment As Segment) Dim canvas As New Bitmap(PictureBox1.Width, PictureBox1.Height) Dim displaySegList As New List(Of Segment) Dim notDisplaySegList As New List(Of Segment) For Each seg As Segment In [Enum].GetValues(GetType(Segment)) If (seg And selectSegment) = seg Then displaySegList.Add(seg) Else notDisplaySegList.Add(seg) End If Next Using g As Graphics = Graphics.FromImage(canvas) '非表示セグメントの描写 For Each seg As Segment In notDisplaySegList Dim action As Action(Of Graphics, Boolean) = _dicSegAction(seg) action.Invoke(g, False) Next '表示セグメントの描写 For Each seg As Segment In displaySegList If _dicSegAction.ContainsKey(seg) Then Dim action As Action(Of Graphics, Boolean) = _dicSegAction(seg) action.Invoke(g, True) End If Next Me.PictureBox1.Image = canvas End Using End Sub #End Region #Region "Segment" Private Sub DrawSeg1a(ByVal g As Graphics, ByVal isActive As Boolean) DrawSegmentLine(g, _leftTop, _centerTop, isActive) End Sub Private Sub DrawSeg2m(ByVal g As Graphics, ByVal isActive As Boolean) DrawSegmentLine(g, _centerTop, _center, isActive) End Sub Private Sub DrawSeg3k(ByVal g As Graphics, ByVal isActive As Boolean) DrawSegmentLine(g, _leftTop, _center, isActive) End Sub Private Sub DrawSeg4h(ByVal g As Graphics, ByVal isActive As Boolean) DrawSegmentLine(g, _leftTop, _leftCenter, isActive) End Sub Private Sub DrawSeg5u(ByVal g As Graphics, ByVal isActive As Boolean) DrawSegmentLine(g, _leftCenter, _center, isActive) End Sub Private Sub DrawSeg6s(ByVal g As Graphics, ByVal isActive As Boolean) DrawSegmentLine(g, _center, _centerDown, isActive) End Sub Private Sub DrawSeg7t(ByVal g As Graphics, ByVal isActive As Boolean) DrawSegmentLine(g, _center, _leftDown, isActive) End Sub Private Sub DrawSeg8g(ByVal g As Graphics, ByVal isActive As Boolean) DrawSegmentLine(g, _leftCenter, _leftDown, isActive) End Sub Private Sub DrawSeg9f(ByVal g As Graphics, ByVal isActive As Boolean) DrawSegmentLine(g, _leftDown, _centerDown, isActive) End Sub Private Sub DrawSeg10e(ByVal g As Graphics, ByVal isActive As Boolean) DrawSegmentLine(g, _centerDown, _rightDown, isActive) End Sub Private Sub DrawSeg12(ByVal g As Graphics, ByVal isActive As Boolean) 'Dim pen As Pen 'If isActive Then ' pen = New Pen(Brushes.Red, _segmentBold) 'Else ' pen = New Pen(Brushes.LightGray, _segmentBold) 'End If 'Dim sX As Integer = _rightDown.X + _segmentBold + 5 'Dim sy As Integer = _rightDown.Y 'Dim rect As New Rectangle(sX, sy, sX + _segmentBold, sy + _segmentBold) 'g.DrawRectangle(pen, rect) End Sub Private Sub DrawSeg13d(ByVal g As Graphics, ByVal isActive As Boolean) DrawSegmentLine(g, _rightCenter, _rightDown, isActive) End Sub Private Sub DrawSeg14r(ByVal g As Graphics, ByVal isActive As Boolean) DrawSegmentLine(g, _center, _rightDown, isActive) End Sub Private Sub DrawSeg15p(ByVal g As Graphics, ByVal isActive As Boolean) DrawSegmentLine(g, _center, _rightCenter, isActive) End Sub Private Sub DrawSeg16c(ByVal g As Graphics, ByVal isActive As Boolean) DrawSegmentLine(g, _rightTop, _rightCenter, isActive) End Sub Private Sub DrawSeg17n(ByVal g As Graphics, ByVal isActive As Boolean) DrawSegmentLine(g, _center, _rightTop, isActive) End Sub Private Sub DrawSeg18b(ByVal g As Graphics, ByVal isActive As Boolean) DrawSegmentLine(g, _centerTop, _rightTop, isActive) End Sub Private Sub DrawSegmentLine(ByVal g As Graphics, ByVal startPoint As Point, ByVal endPoint As Point, ByVal isActive As Boolean) Dim pen As Pen If isActive Then pen = New Pen(Brushes.Red, _segmentBold) Else pen = New Pen(Brushes.LightGray, _segmentBold) End If g.DrawLine(pen, startPoint, endPoint) End Sub #End Region End Class
2次元ライブラリ
オセロ、将棋、五目並べ、ナンバークロスワード、ロジックパズルなどなど、世の中には多くのボードゲームがある。プログラムでこれらを実現しようとしたとき2次元座標を管理しなくてはいけない。2次元座標を管理するにはよく2次元配列が利用される。しかしボードゲームにありがちな、列や行、斜め線の走査といった処理を行う時、2次元座標では不便である。そこでボードゲームのボードを管理するクラスを作成した。
基本的な機能
作成したクラスは次の通り
・Cell(Of T) セル。x座標、y座標、セルの値を含む。
・Line(Of T) ライン。複数のセルを含む。
・Board(Of T) ボード。2次元座標を管理する。
ボードには任意のラインを抽出する機能がある。この機能を利用して、ボードオブジェクトは縦のライン、横のライン、斜めのライン（２つ）をプロパティとして最初から保持している。ラインに含まれるセルオブジェクトはボードや各ラインで共有されているので、このセルの値を書き換えると全体に反映される。
コード
セル
''' <summary> ''' セル ''' </summary> ''' <typeparam name="T"></typeparam> ''' <remarks></remarks> Public Class Cell(Of T) #Region "Variables" Private ReadOnly _x As Integer Private ReadOnly _y As Integer Private _value As T #End Region #Region "Properties" Public ReadOnly Property X() As Integer Get Return _x End Get End Property Public ReadOnly Property Y() As Integer Get Return _y End Get End Property Public Property Value() As T Get Return _value End Get Set(ByVal value As T) If value Is Nothing Then Throw New ArgumentNullException("val") Me._value = value End Set End Property #End Region #Region "Initialize" Public Sub New(ByVal value As T, ByVal x As Integer, ByVal y As Integer) If value Is Nothing Then Throw New ArgumentNullException("value") If Not 0 <= x Then Throw New ArgumentOutOfRangeException("x") If Not 0 <= y Then Throw New ArgumentOutOfRangeException("y") Me.Value = value Me._x = x Me._y = y End Sub #End Region End Class
ライン
''' <summary> ''' ライン ''' </summary> ''' <typeparam name="T"></typeparam> ''' <remarks></remarks> Public Class Line(Of T) Inherits List(Of Cell(Of T)) End Class
ボード
Imports System.Collections.ObjectModel Public Class Board(Of T) #Region "Variables" Private ReadOnly _width As Integer Private ReadOnly _height As Integer Private ReadOnly _boardCells(,) As Cell(Of T) Private ReadOnly _verticalLines As ReadOnlyCollection(Of Line(Of T)) Private ReadOnly _horizontalLines As ReadOnlyCollection(Of Line(Of T)) Private ReadOnly _slashRightDownLines As ReadOnlyCollection(Of Line(Of T)) Private ReadOnly _slashLeftDownLines As ReadOnlyCollection(Of Line(Of T)) #End Region #Region "Properties" Public ReadOnly Property Width() As Integer Get Return _width End Get End Property Public ReadOnly Property Height() As Integer Get Return _height End Get End Property Default Public ReadOnly Property Item(ByVal x As Integer, ByVal y As Integer) As T Get Return GetCellValue(x, y) End Get End Property Public ReadOnly Property HorizontalLines() As ReadOnlyCollection(Of Line(Of T)) Get Return _horizontalLines End Get End Property Public ReadOnly Property VerticalLines() As ReadOnlyCollection(Of Line(Of T)) Get Return _verticalLines End Get End Property Public ReadOnly Property SlashRightDownLines() As ReadOnlyCollection(Of Line(Of T)) Get Return _slashRightDownLines End Get End Property Public ReadOnly Property SlashLeftDownLines() As ReadOnlyCollection(Of Line(Of T)) Get Return _slashLeftDownLines End Get End Property #End Region #Region "Initialize" Public Sub New(ByVal defaultType As T, ByVal width As Integer, ByVal height As Integer) If defaultType Is Nothing Then Throw New ArgumentNullException("val") If Not 0 < width Then Throw New ArgumentOutOfRangeException("width") If Not 0 < height Then Throw New ArgumentOutOfRangeException("height") Me._boardCells = New Cell(Of T)(width - 1, height - 1) {} Dim length As Integer = Me._boardCells.Length For i = 0 To length - 1 Dim x As Integer = i Mod width Dim y As Integer = CInt(Math.Floor(i / width)) Me._boardCells(x, y) = New Cell(Of T)(defaultType, x, y) Next Me._width = width Me._height = height Me._verticalLines = SelectVerticalLines() Me._horizontalLines = SelectHorizontalLines() Me._slashLeftDownLines = SelectSlashRightTopToLeftDown() Me._slashRightDownLines = SelectSlashLeftTopToRightDown() End Sub #End Region #Region "Private Methods" Protected Function SelectVerticalLines() As ReadOnlyCollection(Of Line(Of T)) Dim startPoint As New List(Of Point) For x As Integer = 0 To Width - 1 startPoint.Add(New Point(x, 0)) Next Return SelectLines(startPoint, 0, 1) End Function Protected Function SelectHorizontalLines() As ReadOnlyCollection(Of Line(Of T)) Dim startPoint As New List(Of Point) For y As Integer = 0 To Height - 1 startPoint.Add(New Point(0, y)) Next Return SelectLines(startPoint, 1, 0) End Function Protected Function SelectSlashRightTopToLeftDown() As ReadOnlyCollection(Of Line(Of T)) Dim list As New List(Of Point) For x As Integer = 0 To Width - 1 list.Add(New Point(x, 0)) Next For y As Integer = 1 To Height - 1 list.Add(New Point(Width - 1, y)) Next Return SelectLines(list, -1, 1) End Function Protected Function SelectSlashLeftTopToRightDown() As ReadOnlyCollection(Of Line(Of T)) Dim list As New List(Of Point) For x As Integer = 0 To Width - 1 list.Add(New Point(x, 0)) Next For y As Integer = 1 To Height - 1 list.Add(New Point(0, y)) Next Return SelectLines(list, 1, 1) End Function Private Function IsRangeX(ByVal x As Integer) As Boolean If Not 0 <= x Then Return False If Not x < Width Then Return False Return True End Function Private Function IsRangeY(ByVal y As Integer) As Boolean If Not 0 <= y Then Return False If Not y < Height Then Return False Return True End Function Public Function GetCell(ByVal x As Integer, ByVal y As Integer) As Cell(Of T) If Not IsRangeX(x) Then Throw New ArgumentOutOfRangeException("x") If Not IsRangeY(y) Then Throw New ArgumentOutOfRangeException("y") Return Me._boardCells(x, y) End Function #End Region #Region "Public Methods" Public Function GetCellValue(ByVal x As Integer, ByVal y As Integer) As T Return GetCell(x, y).Value End Function Public Sub SetCellValue(ByVal value As T, ByVal x As Integer, ByVal y As Integer) GetCell(x, y).Value = value End Sub Public Function SelectLines(ByVal startPointList As IEnumerable(Of Point), ByVal directionX As Integer, ByVal directionY As Integer) As ReadOnlyCollection(Of Line(Of T)) If startPointList Is Nothing Then Throw New ArgumentNullException("startPoint") If directionX = 0 AndAlso directionY = 0 Then Throw New ArgumentException("directionXとdirectionYの両方を0にすることはできません。") Dim lineList As New List(Of Line(Of T)) For Each p As Point In startPointList Dim line As Line(Of T) = SelectSingleLine(p, directionX, directionY) lineList.Add(line) Next Return lineList.AsReadOnly End Function Public Function SelectSingleLine(ByVal startPoint As Point, ByVal directionX As Integer, ByVal directionY As Integer) As Line(Of T) If Not IsRangeX(startPoint.X) Then Throw New ArgumentOutOfRangeException("startPoint.X") If Not IsRangeY(startPoint.Y) Then Throw New ArgumentOutOfRangeException("startPoint.Y") If directionX = 0 AndAlso directionY = 0 Then Throw New ArgumentException("directionXとdirectionYの両方を0にすることはできません。") Dim line As New Line(Of T) Dim cell As Cell(Of T) = GetCell(startPoint.X, startPoint.Y) line.Add(cell) While (True) startPoint.X = startPoint.X + directionX startPoint.Y = startPoint.Y + directionY Try cell = GetCell(startPoint.X, startPoint.Y) Catch ex As ArgumentOutOfRangeException Exit While End Try line.Add(cell) End While Return line End Function #End Region End Class
ライブラリは以上。
利用例
このライブラリの利用例、兼テストコード。
Public Enum MyCell Zero One Two Three Four Five Six Seven Eight Nine End Enum
Public Class MyBoard Inherits Board(Of MyCell) Sub New() MyBase.New(MyCell.Zero, 3, 3) End Sub End Class
Imports BoardGame Imports System.Collections.ObjectModel Module Module1 Sub Main() Dim board As New MyBoard() Assert(3, board.Height) Assert(3, board.Width) board.SetCellValue(MyCell.One, 0, 0) board.SetCellValue(MyCell.Two, 1, 0) board.SetCellValue(MyCell.Three, 2, 0) board.SetCellValue(MyCell.Four, 0, 1) board.SetCellValue(MyCell.Five, 1, 1) board.SetCellValue(MyCell.Six, 2, 1) board.SetCellValue(MyCell.Seven, 0, 2) board.SetCellValue(MyCell.Eight, 1, 2) board.SetCellValue(MyCell.Nine, 2, 2) Assert(MyCell.One, board(0, 0)) Assert(MyCell.Two, board(1, 0)) Assert(MyCell.Three, board(2, 0)) Assert(MyCell.Four, board(0, 1)) Assert(MyCell.Five, board(1, 1)) Assert(MyCell.Six, board(2, 1)) Assert(MyCell.Seven, board(0, 2)) Assert(MyCell.Eight, board(1, 2)) Assert(MyCell.Nine, board(2, 2)) Dim currentLineList As ReadOnlyCollection(Of Line(Of MyCell)) '水平のライン currentLineList = board.VerticalLines Assert(3, currentLineList.Count) CheckSameValue(New MyCell() {MyCell.One, MyCell.Four, MyCell.Seven}, currentLineList(0)) CheckSameValue(New MyCell() {MyCell.Two, MyCell.Five, MyCell.Eight}, currentLineList(1)) CheckSameValue(New MyCell() {MyCell.Three, MyCell.Six, MyCell.Nine}, currentLineList(2)) '垂直のライン currentLineList = board.HorizontalLines Assert(3, currentLineList.Count) CheckSameValue(New MyCell() {MyCell.One, MyCell.Two, MyCell.Three}, currentLineList(0)) CheckSameValue(New MyCell() {MyCell.Four, MyCell.Five, MyCell.Six}, currentLineList(1)) CheckSameValue(New MyCell() {MyCell.Seven, MyCell.Eight, MyCell.Nine}, currentLineList(2)) '右上から左下に向けてのライン currentLineList = board.SlashLeftDownLines Assert(5, currentLineList.Count) CheckSameValue(New MyCell() {MyCell.One}, currentLineList(0)) CheckSameValue(New MyCell() {MyCell.Two, MyCell.Four}, currentLineList(1)) CheckSameValue(New MyCell() {MyCell.Three, MyCell.Five, MyCell.Seven}, currentLineList(2)) CheckSameValue(New MyCell() {MyCell.Six, MyCell.Eight}, currentLineList(3)) CheckSameValue(New MyCell() {MyCell.Nine}, currentLineList(4)) '左上から右下に向けてのライン currentLineList = board.SlashRightDownLines Assert(5, currentLineList.Count) CheckSameValue(New MyCell() {MyCell.One, MyCell.Five, MyCell.Nine}, currentLineList(0)) CheckSameValue(New MyCell() {MyCell.Two, MyCell.Six}, currentLineList(1)) CheckSameValue(New MyCell() {MyCell.Three}, currentLineList(2)) CheckSameValue(New MyCell() {MyCell.Four, MyCell.Eight}, currentLineList(3)) CheckSameValue(New MyCell() {MyCell.Seven}, currentLineList(4)) End Sub Sub Assert(Of V)(ByVal expected As V, ByVal actual As V) If Not expected.Equals(actual) Then 'Dim stack As New StackFrame(0) 'Dim point As Integer = stack.GetFileColumnNumber Dim msg As String = "「" & expected.ToString & "」が期待されていましたが、「" & If(actual Is Nothing, "Nothing", actual.ToString) & "」が検出されました。" Throw New InvalidOperationException(msg) End If End Sub Private Sub CheckSameValue(ByVal expected As IEnumerable(Of MyCell), ByVal actual As Line(Of MyCell)) Assert(expected.Count, actual.Count) For i = 0 To expected.Count - 1 Assert(expected(i), actual(i).Value) Next End Sub End Module
リージョンを挿入するスニペット
私はVBのコードを書く場合、Regionを使って変数、コンストラクタ、メソッドといった区分でコードを分類している。しかし毎回Regionを用意するのは面倒だ。そこでこんなスニペットを用意してRegionの挿入を簡単にしてみた。
シンプルなリージョンを追加するスニペット
<?xml version="1.0" encoding="utf-8"?> <CodeSnippets xmlns="http://schemas.microsoft.com/VisualStudio/2005/CodeSnippet"> <CodeSnippet Format="1.0.0"> <Header> <Title>Region Simple</Title> <Description>リージョン</Description> <Shortcut>sreg</Shortcut> </Header> <Snippet> <Code Language="VB"> <![CDATA[#Region "Variables" #End Region #Region "Properties" #End Region #Region "Initialize" #End Region #Region "Method" #End Region]]> </Code> </Snippet> </CodeSnippet> </CodeSnippets>
いろいろなリージョンを追加するスニペット
<?xml version="1.0" encoding="utf-8"?> <CodeSnippets xmlns="http://schemas.microsoft.com/VisualStudio/2005/CodeSnippet"> <CodeSnippet Format="1.0.0"> <Header> <Title>Region All</Title> <Description>リージョン</Description> <Shortcut>areg</Shortcut> </Header> <Snippet> <Code Language="VB"> <![CDATA[ #Region "Variables" #End Region #Region "Properties" #End Region #Region "Shared Methods" #End Region #Region "Initialize" #End Region #Region "Methods" #End Region #Region "Events" #End Region]]> </Code> </Snippet> </CodeSnippet> </CodeSnippets>
カスタムスニペットのテンプレ
VisualStudioのスニペットはユーザーが自由に作成することができる。そのスニペットファイルのテンプレートを書いてみた。拡張子は（.snippet）にする。Shortcutタグは設定しておくととても便利。
コード
<?xml version="1.0" encoding="utf-8"?> <CodeSnippets xmlns="http://schemas.microsoft.com/VisualStudio/2005/CodeSnippet"> <CodeSnippet Format="1.0.0"> <Header> <Title>テンプレ</Title> <Description>テンプレです</Description> <Shortcut>hello</Shortcut> </Header> <Snippet> <!--テンプレートのマニュアル http://msdn.microsoft.com/ja-jp/library/vstudio/ms165394.aspx--> <!--<References> <Reference> <Assembly>test.dll</Assembly> </Reference> </References>--> <!--<Imports> <Import> <Namespace>System.Windows.Forms</Namespace> </Import> </Imports>--> <!--<Declarations> <Literal> <ID>SqlConnString</ID> <ToolTip>Replace with a SQL connection string.</ToolTip> <Default>"SQL connection string"</Default> </Literal> <Object> <ID>SqlConnection</ID> <Type>System.Data.SqlClient.SqlConnection</Type> <ToolTip>Replace with a connection object in your application.</ToolTip> <Default>dcConnection</Default> </Object> </Declarations>--> <Code Language="VB"> <![CDATA[ Hello, Snippet ]]> </Code> </Snippet> </CodeSnippet> </CodeSnippets>
任意のオブジェクトを任意のプロパティに基いてソート その2
前の記事で書いたコードでは各プロパティごとにソート方法が固定だったので、任意のプロパティだけソート方法を変更するための拡張機能を実装した。あまりテストしてないのでまたなおすかも。
ソースコード
Imports System.Reflection Public Class CustomComparisonCreater(Of T) Inherits ComparisonCreater(Of T) Private _customComp As Dictionary(Of String, Comparison(Of T)) = New Dictionary(Of String, Comparison(Of T)) Private NotCompareComparison As Comparison(Of T) = Function(x, y) 0 '比較をしないComparison Public Sub New() End Sub ''' <summary> ''' T型の指定したプロパティに基いて任意の比較を行うためのComparisonを登録 ''' ''' </summary> ''' <param name="propName"></param> ''' <param name="comp">昇順のComparison</param> ''' <remarks></remarks> Public Sub AddComp(ByVal propName As String, ByVal comp As Comparison(Of T)) If propName Is Nothing OrElse comp Is Nothing Then Throw New ArgumentNullException Dim prop As PropertyInfo = GetProp(propName) If prop Is Nothing Then Throw New ArgumentException Dim key As String = prop.Name If Me._customComp.ContainsKey(key) Then Me._customComp(key) = comp Else Me._customComp.Add(key, comp) End If End Sub Public Sub AddNotCompare(ByVal propName As String) If propName Is Nothing Then Throw New ArgumentNullException Dim prop As PropertyInfo = GetProp(propName) If prop Is Nothing Then Throw New ArgumentException Dim key As String = prop.Name If Me._customComp.ContainsKey(key) Then Me._customComp(key) = Me.NotCompareComparison Else Me._customComp.Add(key, Me.NotCompareComparison) End If End Sub Public Overrides Function GetPropAscComparison(ByVal propName As String) As System.Comparison(Of T) If propName Is Nothing Then Throw New ArgumentNullException If Me._customComp.ContainsKey(propName) Then Return Me._customComp(propName) Else Return MyBase.GetPropAscComparison(propName) End If End Function Public Overrides Function GetPropDescComparison(ByVal propName As String) As System.Comparison(Of T) If propName Is Nothing Then Throw New ArgumentNullException If Me._customComp.ContainsKey(propName) Then Return ReverseComp(Me._customComp(propName)) Else Return MyBase.GetPropDescComparison(propName) End If End Function End Class
任意のオブジェクトを任意のプロパティに基いてソート
概要
例えばHumanという型があって、Id,Name,AgeというPublicプロパティを持っていた時、List(Of Human)をHumanの任意のプロパティに基いてソートを行いときがある。この処理を行いたいとき、List(Of T)のSortメソッドでは引数として任意のComparison(Of T)やIComparer(Of T)を渡すことで、独自の並び替え方法を提供することができる。これを利用しない手はない。
しかし何種類ものソート方法を提供したいとき、その数にあわせてComparisonまたはIComparerを実装する必要があり、なかなか手間のかかる作業だ。そこでリフレクションを用いて任意の型Tの任意のパブリックプロパティに基いてComparisonを自動生成するクラスを作成した。
機能説明
任意の型Tのプロパティ名を指定することで新しいComarisonを作成できる。指定したプロパティがComparableを実装していれば、そのComparableのComparaToを用いて比較を行う。指定したプロパティがComparableを実装していなければ、そのプロパティを一旦Stringに変換してComparaToで比較を行う。
ソースコード
Imports System.Reflection ''' <summary> ''' 任意のオブジェクトTを任意のプロパティに基いてソートするためのComparisonを生成するクラス ''' </summary> ''' <remarks></remarks> Public Class ComparisonCreater(Of T) #Region "Comparisonの取得メソッド" ''' <summary> ''' Tを指定したプロパティに基いて比較するためのComparisonを返す ''' </summary> ''' <param name="sortType">降順、昇順を選択可能</param> ''' <returns></returns> ''' <remarks></remarks> Public Function GetComparison(ByVal propName As String, ByVal sortType As SortType) As Comparison(Of T) If propName Is Nothing Then Throw New ArgumentNullException Select Case sortType Case sortType.Asc Return GetPropAscComparison(propName) Case sortType.Desc Return GetPropDescComparison(propName) Case sortType.None Throw New ArgumentException Case Else Throw New InvalidOperationException End Select Return Nothing End Function ''' <summary> ''' Tを指定したプロパティ(昇順)に基いて比較するためのComparisonを返す ''' ''' 指定したプロパティがIComparableを実装している場合それを利用して比較する ''' IComparableを実装していない場合、Stringに変換して比較する ''' </summary> ''' <param name="propName">Tのプロパティ名</param> ''' <returns></returns> ''' <remarks></remarks> Public Overridable Function GetPropAscComparison(ByVal propName As String) As Comparison(Of T) Dim prop As PropertyInfo = GetProp(propName) If prop Is Nothing Then Return Nothing Dim type As Type = prop.GetGetMethod.ReturnType 'IComparableを実装しているか If Not type.GetInterface("IComparable") Is Nothing Then '実装しているとき Return Function(x, y) _ DirectCast(prop.GetValue(y, Nothing), IComparable).CompareTo( _ DirectCast(prop.GetValue(x, Nothing), IComparable)) Else '実装してないときはStringに変換して比較 Return Function(x, y) prop.GetValue(y, Nothing).ToString.CompareTo( _ prop.GetValue(x, Nothing).ToString) End If End Function ''' <summary> ''' Tを指定したプロパティ(降順)に基いて比較するためのComparisonを返す ''' </summary> ''' <param name="propName">Tのプロパティ名</param> ''' <returns></returns> ''' <remarks></remarks> Public Overridable Function GetPropDescComparison(ByVal propName As String) As Comparison(Of T) Dim comp As Comparison(Of T) = GetPropAscComparison(propName) Return ReverseComp(comp) End Function Protected Function ReverseComp(ByVal comp As Comparison(Of T)) As Comparison(Of T) If comp Is Nothing Then Throw New ArgumentNullException Return Function(x, y) comp(y, x) End Function #End Region #Region "基本的なリフレクションの処理" ''' <summary> ''' 指定された型Tのパブリックプロパティの数を数える ''' </summary> ''' <returns></returns> ''' <remarks></remarks> Protected Function PropCount() As Integer Dim type As Type = GetType(T) Dim count As Integer = 0 For Each prop As PropertyInfo In type.GetProperties If Not prop.GetGetMethod(False) Is Nothing Then count += 1 End If Next Return count End Function ''' <summary> ''' 指定されたプロパティがTに含まれるか ''' </summary> ''' <param name="propName">Tのプロパティ名</param> ''' <returns></returns> ''' <remarks></remarks> Protected Function ContainsProp(ByVal propName As String, Optional ByVal nonPublic As Boolean = False) As Boolean Dim prop As PropertyInfo = GetProp(propName) If prop Is Nothing Then Return False Return If(prop.GetGetMethod(nonPublic) Is Nothing, False, True) End Function ''' <summary> ''' Tから指定したプロパティを取得する ''' </summary> ''' <param name="propName">Tのプロパティ名</param> ''' <returns>指定したプロパティが無ければnull</returns> ''' <remarks></remarks> Protected Function GetProp(ByVal propName As String) As PropertyInfo Dim type As Type = GetType(T) Dim prop As PropertyInfo = type.GetProperty(propName) Return prop End Function #End Region End Class Public Enum SortType None Asc Desc End Enum
使い方
Dim creater As New ComparisonCreater(Of Human)() Dim comp As Comparison(Of T) = creater.GetComparison("Name", SortType.Asc) Dim list as new List(of T) '適当な値が入ってるとする list .Sort(comp)
