【案内】小説『エクストリームセンス』について

　小説『エクストリームセンス』は、本ブログを含めていくつか掲載していますが、PC、スマフォ、携帯のいずれでも読みやすいのは、「小説家になろう」サイトだと思います。縦書きのPDFをダウンロードすることもできます。

　小説『エクストリームセンス』のURLは、 http://ncode.syosetu.com/n7174bj/

ラベル 簡単なソフトウェアを作ってみよう の投稿を表示しています。 すべての投稿を表示
ラベル 簡単なソフトウェアを作ってみよう の投稿を表示しています。 すべての投稿を表示

2011年10月23日日曜日

簡単なソフトウェアを作ってみよう(7)

ラベル: , , , ,

簡単なソフトウェアを作ってみよう(4)で公開した、XMLファイルにデータをCRUDするロジックを書き直しました。
LINQ to XMLを使ってスッキリしました。
＊ページ幅にコードを合わせるための改行により、可読性が落ちていますがご容赦ください。

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
'===========================================
'   データアクセス　コンポーネント
'   最終更新日：2011年10月23日
'===========================================
‌ 
Imports System.Xml
‌ 
Public Class DataAccess
‌ 
    Private Structure ItemName
        Friend Const sEmployee As String = "employee"
        Friend Const sID As String = "id"
        Friend Const sName As String = "name"
        Friend Const sBirthday As String = "birthday"
        Friend Const sPostId As String = "postid"
    End Structure
‌ 
    Private DataFile As String =
        System.IO.Directory.GetCurrentDirectory() & "\employee.xml"
‌ 
    Private oXmlDoc As XDocument
‌ 
    '==============
    'DataCreateメソッド
    Public Sub DataCreate(ByVal TargetEmployee As Employee)
        Dim NewRecord As XElement =
            New XElement(New XElement(ItemName.sEmployee,
                             New XElement(ItemName.sID,
                                          TargetEmployee.ID),
                             New XElement(ItemName.sName,
                                          TargetEmployee.Name),
                             New XElement(ItemName.sBirthday,
                                          TargetEmployee.Birthday),
                             New XElement(ItemName.sPostId,
                                          TargetEmployee.PostID)))
        oXmlDoc.Root.Add(NewRecord)
        oXmlDoc.Save(DataFile)
    End Sub
‌ 
    '==============
    'DataUpdateメソッド
    Public Sub DataUpdate(ByVal TargetEmployee As Employee)
        Dim rs =
            From o In oXmlDoc.Descendants(ItemName.sEmployee)
                 Where o.Element(ItemName.sID).Value =
                 TargetEmployee.ID
        With rs.First
            .Element(ItemName.sID).Value =
                TargetEmployee.ID
            .Element(ItemName.sName).Value =
                TargetEmployee.Name
            .Element(ItemName.sBirthday).Value =
                TargetEmployee.Birthday
            .Element(ItemName.sPostId).Value =
                TargetEmployee.PostID
        End With
        oXmlDoc.Save(DataFile)
    End Sub
‌ 
    '==============
    'DataDeleteメソッド
    Public Sub DataDelete(ByVal TargetID As Integer)
        Dim rs =
            From o In oXmlDoc.Descendants(ItemName.sEmployee)
                 Where o.Element(ItemName.sID).Value =
                 CType(TargetID, String)
        rs.First.Remove()
        oXmlDoc.Save(DataFile)
    End Sub
‌ 
    '==============
    'FileLoadメソッド
    Public Sub FileLoad(ByVal list As System.Collections.IList)
        oXmlDoc = XDocument.Load(DataFile)
        Dim rs =
            From o In oXmlDoc.Descendants(ItemName.sEmployee)
        For Each v In rs
            Dim oEmployee As New Employee With {
            .ID = v.Element(ItemName.sID).Value,
            .Name = v.Element(ItemName.sName).Value,
            .Birthday = v.Element(ItemName.sBirthday).Value,
            .PostID = v.Element(ItemName.sPostId).Value
        }
            list.Add(oEmployee)
        Next
    End Sub
‌ 
    '==============
    'コンストラクタ
    Public Sub New()
        If System.IO.File.Exists(DataFile) = False Then
            Dim XMLFileFormat As String =
            "<?xml version=""1.0"" encoding=""utf-8""?><root></root>"
            System.IO.File.WriteAllText(DataFile, XMLFileFormat)
        End If
    End Sub
End Class
0 コメント

2011年10月1日土曜日

簡単なソフトウェアを作ってみよう(6)

ラベル: , , , , ,

ユーザーインターフェースはこんな風になってます。


そしてロジック。

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
'ユーザーインターフェース
‌ 
Public Class frmMain
‌ 
Private ColEmployee As New EmployeeCollection
Private IsIDChanged As Boolean = False
‌ 
'========================
'   テキストボックスのクリア
Private Sub TextBoxclear()
    txtID.Text = ""
    txtName.Text = ""
    txtBirthday.Text = ""
    cmbPost.Text = ""
End Sub
‌ 
'========================
'   登録
Private Sub cmdEntry_Click(ByVal sender As System.Object,
                       ByVal e As System.EventArgs) _
                       Handles cmdEntry.Click
    If IsCheckedValidation(sender) = False Then Exit Sub
    Dim oDataService As New DataService
    ColEmployee.Add(txtID.Text,
                    txtName.Text,
                    CDate(txtBirthday.Text),
                    oDataService.PostName_to_PostID(cmbPost.Text))
    ListUpdate()
    TextBoxclear()
End Sub
‌ 
'========================
'   終了
Private Sub cmdExit_Click(ByVal sender As System.Object,
                      ByVal e As System.EventArgs) _
                      Handles cmdExit.Click
    End
End Sub
‌ 
'========================
'   削除
Private Sub cmdDelete_Click(ByVal sender As System.Object,
                        ByVal e As System.EventArgs) _
                        Handles cmdDelete.Click
    If IsCheckedValidation(sender) = False Then Exit Sub
    If MessageBox.Show("本当に削除してよろしいですか？",
                       "操作の確認",
                       MessageBoxButtons.YesNo,
                       MessageBoxIcon.Question) = vbNo Then Exit Sub
    Dim oDataService As New DataService
    Dim TargetEmployee As New Employee With {
        .ID = CType(txtID.Text, Integer)
    }
    ColEmployee.Remove(TargetEmployee)
    ListUpdate()
    TextBoxclear()
End Sub
‌ 
'========================
'   更新
Private Sub cmdUpdate_Click(ByVal sender As System.Object,
                        ByVal e As System.EventArgs) _
                        Handles cmdUpdate.Click
    If IsCheckedValidation(sender) = False Then Exit Sub
    If MessageBox.Show("本当に更新してよろしいですか？",
                       "操作の確認",
                       MessageBoxButtons.YesNo,
                       MessageBoxIcon.Question) = vbNo Then Exit Sub
    Dim oDataService As New DataService
    Dim TargetEmployee As New Employee With {
        .ID = CType(txtID.Text, Integer),
        .Name = txtName.Text,
        .Birthday = CType(txtBirthday.Value, Date),
        .PostID = oDataService.PostName_to_PostID(cmbPost.Text)
    }
    ColEmployee.Update(TargetEmployee)
    ListUpdate()
    TextBoxclear()
End Sub
‌ 
'========================
'   フォームロード時
Private Sub frmMain_Load(ByVal sender As Object,
                         ByVal e As System.EventArgs) Handles Me.Load
    'ID
    Dim dgvTextBoxColumn_ID As New DataGridViewTextBoxColumn
    With dgvTextBoxColumn_ID
        .HeaderText = "ID"
        .Width = 55
    End With
    '氏名
    Dim dgvTextBoxColumn_Name As New DataGridViewTextBoxColumn
    dgvTextBoxColumn_Name.HeaderText = "氏名"
    '生年月日
    Dim dgvTestBoxColumn_Birthday As New DataGridViewTextBoxColumn
    With dgvTestBoxColumn_Birthday
        .HeaderText = "生年月日"
        .Width = 80
    End With
    '年齢
    Dim dgvTestBoxColumn_Age As New DataGridViewTextBoxColumn
    With dgvTestBoxColumn_Age
        .HeaderText = "年齢"
        .Width = 55
        .DefaultCellStyle.Alignment =
            DataGridViewContentAlignment.MiddleRight
    End With
    '所属部署
    Dim dgvTestBoxColumn_Post As New DataGridViewTextBoxColumn
    With dgvTestBoxColumn_Post
        .HeaderText = "所属部署"
        .Width = 100
    End With
    'DataGridView Column Setting
    With dgvEntryList.Columns
        .Add(dgvTextBoxColumn_ID)
        .Add(dgvTextBoxColumn_Name)
        .Add(dgvTestBoxColumn_Birthday)
        .Add(dgvTestBoxColumn_Age)
        .Add(dgvTestBoxColumn_Post)
    End With
    With dgvEntryList
        .SelectionMode = DataGridViewSelectionMode.FullRowSelect
        .AlternatingRowsDefaultCellStyle.BackColor = Color.AliceBlue
        .RowHeadersVisible = False
    End With
    'ComboBox Setting
    Dim oDataService As New DataService
    With cmbPost.Items
     .Add(oDataService.PostID_to_PostName(DataService.PostNos.Soumu))
     .Add(oDataService.PostID_to_PostName(DataService.PostNos.KeieiKikaku))
     .Add(oDataService.PostID_to_PostName(DataService.PostNos.Jigyo))
    End With
    ListUpdate()
End Sub
‌ 
'========================
'   メニュー（終了）
Private Sub MenuItemEnd_Click(ByVal sender As System.Object,
                          ByVal e As System.EventArgs) _
                          Handles MenuItemEnd.Click
    cmdExit_Click(sender, e)
End Sub
‌ 
'========================
'   Grid更新メソッド
Private Sub ListUpdate()
    dgvEntryList.Rows.Clear()
    Dim oDataService As New DataService
    Dim rs = From o As Employee In ColEmployee
             Order By o.ID Ascending
    For Each v As Employee In rs
        dgvEntryList.Rows.Add(v.ID,
                              v.Name,
                              CType(v.Birthday, String),
                              v.Age,
                              oDataService.PostID_to_PostName(v.PostID))
    Next
    ToolStripStatusLabel1.Text = "登録者数 : " & ColEmployee.Count
    '平均年齢
    If ColEmployee.Count = 0 Then
        ToolStripStatusLabel2.Text = ""
    Else
        ToolStripStatusLabel2.Text = "平均年齢 : " &
            Format(ColEmployee.AveAge, "0.0歳")
    End If
End Sub
‌ 
'========================
'   Gridクリックイベント
Private Sub dgvEntryList_Click(ByVal sender As Object,
                           ByVal e As System.EventArgs) _
                           Handles dgvEntryList.Click
    If dgvEntryList.Rows.Count = 0 Then Exit Sub
    txtID.Text =
        CType(dgvEntryList.SelectedRows(0).Cells(0).Value, String)
    IsIDChanged = False
    txtName.Text =
        CType(dgvEntryList.SelectedRows(0).Cells(1).Value, String)
    txtBirthday.Text =
        CType(dgvEntryList.SelectedRows(0).Cells(2).Value, String)
    cmbPost.Text =
        CType(dgvEntryList.SelectedRows(0).Cells(4).Value, String)
End Sub
‌ 
'========================
'   ID TextChanged イベント
Private Sub txtID_TextChanged(ByVal sender As System.Object,
                          ByVal e As System.EventArgs) _
                          Handles txtID.TextChanged
    IsIDChanged = True
End Sub
‌ 
'========================
'   IsCheckedValidation メソッド
Private Function IsCheckedValidation(ByVal sender As System.Object) _
    As Boolean
    Dim Response As Boolean = False
    Select Case CType(sender, Button).Name
        Case "cmdEntry"
            '^^^^^^^^^^^^^^^^^^^^^^
            If txtID.Text =
                "" Or txtName.Text = "" Or txtBirthday.Text = "" Then
                MessageBox.Show("必須項目が入力されていません。",
                                "入力確認",
                                MessageBoxButtons.OK,
                                MessageBoxIcon.Error)
                Response = False
                Return Response
                Exit Function
            Else
                Response = True
            End If
        Case "cmdDelete"
            '^^^^^^^^^^^^^^^^^^^^^^
            If txtID.Text = "" Then
                MessageBox.Show("削除する対象が選択されていません。",
                                "操作確認",
                                MessageBoxButtons.OK,
                                MessageBoxIcon.Error)
                Response = False
                Return Response
                Exit Function
            Else
                Response = True
            End If
            If IsIDChanged = True Then
                MessageBox.Show("IDが変更されています。",
                                "操作確認",
                                MessageBoxButtons.OK,
                                MessageBoxIcon.Error)
                txtID.Text =
                    dgvEntryList.SelectedRows(0).Cells(0).Value.ToString
                Response = False
                Return Response
                Exit Function
            Else
                Response = True
            End If
        Case "cmdUpdate"
            '^^^^^^^^^^^^^^^^^^^^^^
            If txtID.Text = "" Then
                MessageBox.Show("更新する対象が選択されていません。",
                                "操作確認",
                                MessageBoxButtons.OK,
                                MessageBoxIcon.Error)
                Response = False
                Return Response
                Exit Function
            Else
                Response = True
            End If
            If IsIDChanged = True Then
                MessageBox.Show("IDが変更されています。",
                                "操作確認",
                                MessageBoxButtons.OK,
                                MessageBoxIcon.Error)
                txtID.Text =
                    dgvEntryList.SelectedRows(0).Cells(0).Value.ToString
                Response = False
                Return Response
                Exit Function
            Else
                Response = True
            End If
        Case Else
            Response = True
    End Select
    Return Response
End Function
End Class
1 コメント
登録: 投稿 (Atom)