プログラムの概要
可愛い烏賊が、画面を泳ぐスクリーンセーバーで有る。烏賊の数、背 景(黒一色かデスクトップ画面)を設定する事が出来る。 背景が、黒一色の場合は、単に烏賊が、左右から現れては、反対側に 泳いで行く丈だが、デスクトップ画面の場合は、徐々に背景が烏賊の 形に塗り潰されて行く。 スクリーンセーバーの本来の目的は、ディスプレイの焼き付きを防止 する事で有るが、現在では、ブラウン管式のディスプレイは、殆ど観掛けず、液晶式のディスプレイで は、此の事に余り拘る必要は無く、観て楽しい物が主流で有る。猶、Visual Basic 2005 Express には、スクリーンセーバーキットが有り、簡単にスクリーンセーバー を作成する事が出来る。 一般的に、実用プログラムに比較するとゲームプログラムは、高度なテクニックを要求される事が多い。 此処では、ゲームプログラムを作成する事に依り、楽しみ乍ら、プログラムの制作手順を習得する事を 目的として居る。 制作手順としては、実際の作業過程に従い、段階的に機能を追加する方法を採用して居る。 此のプログラムを土台に、更に、各自で機能を追加して行く事が望まれる。
烏賊セーバー
VB 2005 ○71 □ アプリケーション画面のデザイン(標準コントロールの利用) □ プログラムの動作原理(イベント駆動型のプログラム) □ プログラムの構成要素(オブジェクトとプロパティ) □ 値の代入(変数、オブジェクトのプロパティ) □ グラフィックスの利用(Graphics オブジェクト) □ 条件に応じた処理(If 文の利用) □ 自動的に行われる処理(タイマーの利用) 今回の課題項目■ メイン画面用 ■ コントロールの種類 プロパティ プロパティの設定値 フォーム Name frmScr BackColor 0, 128, 255 FormBorderStyle None KeyPreview True WindowState Maximized ラベル Name lblMessage BackColor Transparent Font MS 明朝, 24.0!, Bold ForeColor Navy Text 烏賊セーバー ピクチャボックス Name picScr BackColor Transparent Dock Fill TabStop False タイマー Name picScr Interval 200
オ
オ
ブ
ブ
ジ
ジ
ェ
ェ
ク
ク
ト
ト
・
・
プ
プ
ロ
ロ
パ
パ
テ
テ
ィ
ィ
一
一
覧
覧
ラベル ピクチャボックス タイマー■ 設定画面用 ■ コントロールの種類 プロパティ プロパティの設定値 フォーム Name frmCnfg FormBorderStyle FixedSingle Icon アイコン.ico StartPosition CenterScreen
Text Squid Saver Setup
グループボックス Name grpMessage Font MS 明朝, 12.0!, Bold Text 表示メッセージ テキストボックス Name txtMessage Font MS 明朝, 12.0!, Regular グループボックス Name grpBack Font MS 明朝, 12.0!, Bold Text 背景 ラジオボタン Name radDesktop Checked True Text 背景にデスクトップの画面 ラジオボタン Name radBlank Text 背景は黒一色の塗潰し画面 グループボックス Name grpNumber Font MS 明朝, 12.0!, Bold Text 出現烏賊の最大数 水平スクロールバー Name hsbNumber Minimum 1 Value 50 ラベル Name lblNumber BackColor White Text 50 TextAlign MiddleRight ボタン Name btnOK
Font Times New Roman, 15.75!, Bold
Text &OK
ボタン Name btnCancel
Font Times New Roman, 15.75!, Bold
Imports System.Runtime.InteropServices Public Class frmScr
' API 関数の宣言
Private Declare Auto Function SystemParametersInfo Lib "user32" ( _ ByVal uAction As Integer, _
ByVal uParam As Integer, _ ByVal pvParam As Integer, _ ByVal fuWinIni As Integer _ ) As Boolean
Private Const SPI_SCREENSAVERRUNNING As Long = 97&
' キャラクターのデータを格納する構造体 Private Structure Tchar
Dim X As Integer ' キャラクターX座標 Dim Y As Integer ' キャラクターY座標
Dim Direct As Integer ' キャラクター移動方向(0:右、1:左) Dim Anime As Integer ' アニメーション用フラグ(0~4)
Dim Move As Boolean ' 動作タイプ(False:停止、True:移動)
Dim Type As Integer ' キャラクター種類(0:茶烏賊、1:赤烏賊、2:黒烏賊) End Structure
Private Squid(99) As Tchar ' キャラクターデータ本体 Private Gb, Gf As Graphics
Private Bm(5) As Bitmap
Private Rn As Random = New Random()
' フォームが読み込まれた時の処理
Private Sub frmScr_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles MyBase.Load
' Graphics オブジェクトのインスタンス生成 With picScr
.BackgroundImage = New Bitmap(.Width, .Height) .Image = New Bitmap(.Width, .Height)
Gb = Graphics.FromImage(.BackgroundImage) Gf = Graphics.FromImage(.Image) End With Gb.Clear(Color.Transparent) Gf.Clear(Color.Transparent) ' Bitmap オブジェクトに画像設定 Dim S As String = "" For I As Integer = 0 To 5 S = "Img" & I.ToString()
Bm(I) = My.Resources.ResourceManager.GetObject(S)
プ
Next
' データの初期化
For I As Integer = 0 To (CharMax - 1) Squid(I).X = 0 Squid(I).Y = 0 Squid(I).Anime = 0 Squid(I).Move = False Next I ' Ctrl+Alt+Del キーの無効化
Dim T As Boolean = SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, 0, 0)
' マーキー文字の設定 If Not DispMes = "" Then lblMessage.Left = Me.Width lblMessage.Text = DispMes Else lblMessage.Visible = False End If ' マウスカーソルの消去 System.Windows.Forms.Cursor.Hide() ' タイマーの始動 tmrScr.Enabled = True End Sub ' キーが押し下げられた時の処理
Private Sub frmScr_KeyDown(ByVal sender As Object, _
ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown ' スクリーンセーバーの終了
Me.Close() End Sub
' マウスカーソルが移動した時の処理
Private Sub picScr_MouseMove(ByVal sender As System.Object, _
ByVal e As System.Windows.Forms.MouseEventArgs) Handles picScr.MouseMove Static X, Y As Integer
' マウスカーソルが 3 ピクセル以上移動すればスクリーンセーバーの終了
If (X > 0 And Y > 0) AndAlso (Math.Abs(e.X - X) > 3 Or Math.Abs(e.Y - Y) > 3) Then Me.Close() End If X = e.X : Y = e.Y End Sub ' フォームが閉じられ様と仕た時の処理
Private Sub frmScr_FormClosing(ByVal sender As Object, _
ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing ' タイマーの停止 tmrScr.Enabled = False ' マウスカーソルの表示 System.Windows.Forms.Cursor.Show() ' Ctrl+Alt+Del キーの有効化
Dim T As Boolean = SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, 0, 0) End Sub
' タイマーが一定間隔で自動的に行う処理
Private Sub tmrScr_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles tmrScr.Tick
' マーキー効果(文字列のスクロール)の実施 If lblMessage.Visible Then
If lblMessage.Left < (0 - lblMessage.Width) Then lblMessage.Left = Me.Width End If lblMessage.Left -= 10 End If ' 烏賊の表示 Gf.Clear(Color.Transparent)
For I As Integer = 0 To (CharMax - 1) With Squid(I)
If Not .Move Then ' 停止して居る場合 If Rn.Next(0, 2) = 0 Then ' 右左孰れから出現するかランダムに決定 If Rn.Next(0, 2) = 0 Then .X = -64 - Rn.Next(0, 500) .Y = Rn.Next(-32, (Me.Height - 32)) .Direct = 0 Else .X = Me.Width + Rn.Next(0, 500) .Y = Rn.Next(-32, (Me.Height - 32)) .Direct = 1 End If ' キャラクターの種類決定 .Type = Rn.Next(0, 3) ' アニメーションカウントの初期化 .Anime = 4 ' 動作フラグの設定 .Move = True End If Else
' 移動して居る場合
If (.Direct = 0 AndAlso .Anime = 0) OrElse _ (.Direct = 1 AndAlso .Anime = 4) Then
.X += (IIf(.Direct = 0, 100, -100) + Rn.Next(-5, 6)) Else
.X += (IIf(.Direct = 0, 10, -10) + Rn.Next(-5, 6)) End If
If (.Direct = 0 AndAlso .X > Me.Width) Or _ (.Direct = 1 AndAlso .X < -64) Then .Move = False
Else
Gf.DrawImage(Bm(.Type * 2 + .Direct), .X, .Y, _
New Rectangle(.Anime * 64, 0, 64, 48), GraphicsUnit.Pixel) If ScrType = 0 AndAlso Rn.Next(0, 10) = 0 Then
Gb.DrawImage(Bm(.Type * 2 + .Direct), .X, .Y, _
New Rectangle(.Anime * 64, 48, 64, 48), GraphicsUnit.Pixel) End If
.Anime -= 1 : If .Anime < 0 Then .Anime = 4 End If End If End With Next picScr.Refresh() End Sub End Class ■ 設定画面用 ■ Imports Microsoft.Win32 Imports System.IO Public Class frmCnfg ' ボタン(OK)がクリックされた時の処理
Private Sub btnOK_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles btnOK.Click DispMes = txtMessage.Text If radDesktop.Checked Then ScrType = 0 Else ScrType = 1 End If CharMax = Integer.Parse(lblNumber.Text) If FROM_REGISTRY Then ' HKEY_CURRENT_USER¥Software レジストリに現在の設定を保存
Dim K As RegistryKey = Registry.CurrentUser.OpenSubKey("Software", True) Dim N As RegistryKey = K.CreateSubKey("Squid Saver")
N.SetValue("Message", DispMes) N.SetValue("Background", ScrType) N.SetValue("Number", CharMax) N.Close() : K.Close()
Else
' ファイルに現在の設定を保存 Using Sw As StreamWriter = _
New StreamWriter(ExePath & "SquidSaver.dat", False, System.Text.Encoding.Default) Sw.WriteLine(DispMes) Sw.WriteLine(ScrType) Sw.WriteLine(CharMax) Sw.Close() End Using End If Me.Close() End Sub ' ボタン(CANCEL)がクリックされた時の処理
Private Sub btnCancel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles btnCancel.Click
Me.Close() End Sub
' スクロールバーの値が変化した時の処理
Private Sub hsbNumber_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles hsbNumber.ValueChanged
lblNumber.Text = hsbNumber.Value.ToString() End Sub End Class ■ 標準モジュール ■ Imports Microsoft.Win32 Imports System.IO Imports System.Runtime.InteropServices Imports System.Environment Module modScr
Public Const FROM_REGISTRY As Boolean = False
Public DispMes As String ' 表示メッセージ Public CharMax As Integer ' 最大尾数
Public ScrType As Integer ' スクリーンセーバータイプ(0:デスクトップ、1:ブランク) Public ExePath As String ' 起動パス
' メインサブ
Public Sub Main(ByVal args As String()) Dim P, S As String
Dim F As Boolean = False Dim V As Object
' 起動パスの取得
ExePath = Application.StartupPath
' 設定値の取得
If FROM_REGISTRY Then ' レジストリより取得
Dim R As RegistryKey = Registry.CurrentUser R = R.OpenSubKey("Software¥Squid Saver", True) V = R.GetValue("Message", "") DispMes = V.ToString() V = R.GetValue("Background", "0") ScrType = Integer.Parse(V) V = R.GetValue("Number", "50") CharMax = Integer.Parse(V) R.Close() Else
If File.Exists(ExePath & "SquidSaver.dat") Then Using Sr As StreamReader = _
New StreamReader(ExePath & "SquidSaver.dat", System.Text.Encoding.Default) DispMes = Sr.ReadLine()
S = Sr.ReadLine() : ScrType = Integer.Parse(S) S = Sr.ReadLine() : CharMax = Integer.Parse(S) Sr.Close()
End Using Else
DispMes = "" : ScrType = 0 : CharMax = 50 Using Sw As StreamWriter = _
New StreamWriter(ExePath & "SquidSaver.dat", False, System.Text.Encoding.Default) Sw.WriteLine(DispMes) Sw.WriteLine(ScrType) Sw.WriteLine(CharMax) Sw.Close() End Using End If End If ' テスト用(exe から scr に変更後はコメントアウト) 'ReDim args(0) 'args(0) = "/s" 'args(0) = "/c" 'ScrType = 1 If args.Length > 0 Then P = args(0).Trim().Substring(0, 2).ToLower() If P = "" Then ' ファイルを右クリックして設定を選択した時に発生 P = "/c" End If Select Case P Case "/c"
Dim Frm As Form = New frmCnfg() Frm.ShowDialog() Exit Sub Case "/s" ' 二重起動の検証 F = PrevInstance() If Not F Then ' フォームのインスタンス生成 Dim Frm As Form = New frmScr() ' 画面の設定
If ScrType = 0 Then
' デスクトップ画像の取込
Dim Im As Image = New Bitmap(Screen.PrimaryScreen.Bounds.Width, _ Screen.PrimaryScreen.Bounds.Height)
Dim Gr As Graphics = Graphics.FromImage(Im)
Gr.CopyFromScreen(New Point(0, 0), New Point(0, 0), _ Screen.PrimaryScreen.Bounds.Size) My.Computer.Clipboard.SetImage(Im) Frm.BackgroundImage = Im Else Frm.BackColor = Color.FromArgb(255, 0, 128, 255) End If ' フォームのモーダル表示 Frm.ShowDialog() Exit Sub Else Exit Sub End If Case Else
Dim Frm As Form = New frmCnfg() Frm.ShowDialog() Exit Sub End Select End If ' 通常のアプリケーションを Sub Main から起動なら下記の様にする 'Dim Frm As Form = New frmScr()
'Frm.Show()
'Application.Run(Frm) End Sub
' 二重起動を検証するジェネラルプロシージャ Public Function PrevInstance() As Boolean
If UBound(Diagnostics.Process.GetProcessesByName( _ Diagnostics.Process.GetCurrentProcess.ProcessName)) > 0 Then Return True Else Return False End If
End Function End Module