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

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

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

2011年10月31日月曜日

23インチワイドディスプレイ

これは広くて快適！

23インチワイドディスプレイ
23インチワイドディスプレイ posted by (C)Satohru
0 コメント

2011年10月24日月曜日

Small Basic

ラベル: ,
Small Basicかぁ、なかなか可愛いじゃん。

Small Basic
Small Basic posted by (C)Satohru
0 コメント

2011年10月23日日曜日

LINQ to XMLで簡単Twitterクライアント

ラベル: , ,

LINQ to XMLの便利さを再認識しました。
下記コードは私のつぶやきを取得するサンプルですが、LINQ to XMLだと簡単に処理できました。

Imports System.Xml
Imports System.Globalization
‌ 
Public Class frmTest
‌ 
  Private Sub Button1_Click(ByVal sender As System.Object,
               ByVal e As System.EventArgs) Handles Button1.Click
‌ 
   Dim TwitterDoc As New XDocument
   TwitterDoc = 
    XDocument.Load("https://twitter.com/statuses/user_timeline/Satohru.xml")
   For Each v In TwitterDoc.Descendants("status")
       TextBox1.Text += Date.ParseExact(v.Element("created_at").Value,
                        "ddd MMM dd HH:mm:ss zzz yyyy",
                        CultureInfo.InvariantCulture) & vbCrLf &
                        v.Element("text").Value & vbCrLf & vbCrLf
   Next
‌ 
  End Sub
End Class
0 コメント

簡単なソフトウェアを作ってみよう(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月11日火曜日

ScalaでFizzBuzz

ラベル: , ,
ScalaでFizzBuzzしてみました。
勉強中の言語なのでこんなもんかなぁ…

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
// Scala - FizzBuzz
for ( i <- 1 to 100 ) {
    var Fizz = i % 3
    var Buzz = i % 5
    var Response = ""
    if ((Fizz == 0) && (Buzz != 0)) Response = "Fizz"
    if ((Fizz != 0) && (Buzz == 0)) Response = "Buzz"
    if ((Fizz == 0) && (Buzz == 0)) Response = "FizzBuzz" 
    if (Response == "") println(i) else println(Response)
    }

おまけ(VB.NET)…
1.
2.
3.
4.
5.
6.
7.
8.
9.
 '3の倍数と3の付く数でアホになる関数
    Private Function SanDeAho(ByVal Value As Integer) As String
        Dim Response As String = Value
        Dim x3 As Integer = Value Mod 3
        If 0 <= Value.ToString.IndexOf("3") Or x3 = 0 Then
            Response = Value & "～ん！"    'アホを表現してます
        End If
        Return Response
    End Function
0 コメント

2011年10月9日日曜日

FizzBuzz問題をやってみた

ラベル: , ,
最近、ネットでFizzBuzz問題を目にすることがあったので、私もやってみました。
34行目のFizzBuzz関数は最初に書いたものですが、変数Responseが次々に上書きされることが気に入らなかったので、43行目のFizzBuzz2のように書き直しました。
ループと実行時間測定はおまけです。

追記
ゲームとしてのFizzBuzzを調べてみると、「1, 2, Fizz, 4, Buzz, Fizz, 7, 8…」のように発音するとあるので、このプログラムはゲーム本来の仕様とはズレてますね…


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.
'コンソールアプリケーションを選択
Module Module1
‌ 
    '.NETのStopwatchで実行時間を測定。
    Private oStopwatch As New System.Diagnostics.Stopwatch()
‌ 
    'Main関数
    Sub Main()
        Do
            Console.WriteLine(vbCrLf &
                "FizzBuzzを行う自然数列の最大値を入力してください…")
            Dim Response As String = Console.ReadLine()
            Dim MaxValue As Integer
            'バリデーション
            If Integer.TryParse(Response, MaxValue) = True Then
                oStopwatch.Start()
                For i = 1 To MaxValue
                    Console.WriteLine(FizzBuzz2(i))
                Next
                oStopwatch.Stop()
                Console.WriteLine("実行時間 : " &
                                  oStopwatch.Elapsed.ToString)
                oStopwatch.Reset()
            Else
                Console.WriteLine(vbCrLf &
                                  "入力を数値に変換できませんでした。")
            End If
            Console.WriteLine("もう一度実行する<R>、終了する<R>以外のキー")
            If Console.ReadKey.Key <> ConsoleKey.R Then Exit Sub
        Loop
    End Sub
‌ 
    '最初に書いたFizzBuzz関数
    Private Function FizzBuzz(ByVal Value As Integer) As String
        Dim Response As String = Value
        If (Value Mod 3) = 0 Then Response = Value & " > Fizz"
        If (Value Mod 5) = 0 Then Response = Value & " > Buzz"
        If (Value Mod 15) = 0 Then Response = Value & " > FizzBuzz"
        Return Response
    End Function
‌ 
    '書き直したFizzBuzz関数（FizzBuzz2）
    Private Function FizzBuzz2(ByVal Value As Integer) As String
        Dim Response As String = Value
        Dim x3 As Integer = Value Mod 3
        Dim x5 As Integer = Value Mod 5
        If x3 = 0 And x5 <> 0 Then
            Response = Value & " > Fizz"
        ElseIf x3 <> 0 And x5 = 0 Then
            Response = Value & " > Buzz"
        ElseIf x3 = 0 And x5 = 0 Then
            Response = Value & " > FizzBuzz"
        End If
        Return Response
    End Function
End Module
1 コメント

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)