烏賊セーバー VB 2005 71 プログラムの概要 可愛い烏賊が 画面を泳ぐスクリーンセーバーで有る 烏賊の数 背景 ( 黒一色かデスクトップ画面 ) を設定する事が出来る 背景が 黒一色の場合は 単に烏賊が 左右から現れては 反対側に泳いで行く丈だが デスクトップ画面の場合は 徐々に背景が烏賊の形に塗り潰されて行く スクリーンセーバーの本来の目的は ディスプレイの焼き付きを防止する事で有るが 現在では ブラウン管式のディスプレイは 殆ど観掛けず 液晶式のディスプレイでは 此の事に余り拘る必要は無く 観て楽しい物が主流で有る 猶 Visual Basic 2005 Express には スクリーンセーバーキットが有り 簡単にスクリーンセーバーを作成する事が出来る 一般的に 実用プログラムに比較するとゲームプログラムは 高度なテクニックを要求される事が多い 此処では ゲームプログラムを作成する事に依り 楽しみ乍ら プログラムの制作手順を習得する事を目的として居る 制作手順としては 実際の作業過程に従い 段階的に機能を追加する方法を採用して居る 此のプログラムを土台に 更に 各自で機能を追加して行く事が望まれる 今回の課題項目 アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数 オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -1-
オブジェクト プロパティ一覧 メイン画面用 ピクチャボックス ラベル タイマー コントロールの種類 プロパティ プロパティの設定値 フォーム Name frmscr BackColor 0, 128, 255 FormBorderStyle None KeyPreview True WindowState Maximized ラベル Name lblmessage BackColor Transparent MS 明朝, 24.0!, Bold ForeColor Navy 烏賊セーバー ピクチャボックス Name picscr BackColor Transparent Dock Fill TabStop False タイマー Name picscr Interval 200-2-
設定画面用 コントロールの種類 プロパティ プロパティの設定値 フォーム Name frmcnfg FormBorderStyle FixedSingle Icon アイコン.ico StartPosition CenterScreen Squid Saver Setup グループボックス Name grpmessage MS 明朝, 12.0!, Bold 表示メッセージ テキストボックス Name txtmessage MS 明朝, 12.0!, Regular グループボックス Name grpback MS 明朝, 12.0!, Bold 背景 ラジオボタン Name raddesktop Checked True 背景にデスクトップの画面 ラジオボタン Name radblank 背景は黒一色の塗潰し画面 グループボックス Name grpnumber MS 明朝, 12.0!, Bold 出現烏賊の最大数 水平スクロールバー Name hsbnumber Minimum 1 Value 50 ラベル Name lblnumber BackColor White 50 Align MiddleRight ボタン Name btnok Times New Roman, 15.75!, Bold &OK ボタン Name btncancel Times New Roman, 15.75!, Bold &Cancel -3-
プログラムリスト 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) -4-
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. = DispMes lblmessage.visible = False ' マウスカーソルの消去 System.Windows.Forms.Cursor.Hide() ' タイマーの始動 tmrscr.enabled = True ' キーが押し下げられた時の処理 Private Sub frmscr_keydown(byval sender As Object, _ ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown ' スクリーンセーバーの終了 Me.Close() ' マウスカーソルが移動した時の処理 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() X = e.x : Y = e.y ' フォームが閉じられ様と仕た時の処理 -5-
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) ' タイマーが一定間隔で自動的に行う処理 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 lblmessage.left -= 10 ' 烏賊の表示 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.X = Me.Width + Rn.Next(0, 500).Y = Rn.Next(-32, (Me.Height - 32)).Direct = 1 ' キャラクターの種類決定.Type = Rn.Next(0, 3) ' アニメーションカウントの初期化.Anime = 4 ' 動作フラグの設定.Move = True -6-
' 移動して居る場合 If (.Direct = 0 AndAlso.Anime = 0) Or _ (.Direct = 1 AndAlso.Anime = 4) Then.X += (IIf(.Direct = 0, 100, -100) + Rn.Next(-5, 6)).X += (IIf(.Direct = 0, 10, -10) + Rn.Next(-5, 6)) If (.Direct = 0 AndAlso.X > Me.Width) Or _ (.Direct = 1 AndAlso.X < -64) Then.Move = False 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).Anime -= 1 : If.Anime < 0 Then.Anime = 4 End With Next picscr.refresh() 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. If raddesktop.checked Then ScrType = 0 ScrType = 1 CharMax = Integer.Parse(lblNumber.) 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() -7-
' ファイルに現在の設定を保存 Using Sw As StreamWriter = _ New StreamWriter(ExePath & "SquidSaver.dat", False, System..Encoding.Default) Sw.WriteLine(DispMes) Sw.WriteLine(ScrType) Sw.WriteLine(CharMax) Sw.Close() End Using Me.Close() ' ボタン (CANCEL) がクリックされた時の処理 Private Sub btncancel_click(byval sender As System.Object, ByVal e As System.EventArgs) _ Handles btncancel.click Me.Close() ' スクロールバーの値が変化した時の処理 Private Sub hsbnumber_valuechanged(byval sender As System.Object, ByVal e As System.EventArgs) Handles hsbnumber.valuechanged lblnumber. = hsbnumber.value.tostring() 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 Not ExePath.EndsWith(" ") Then ExePath &= " " -8-
' 設定値の取得 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() If File.Exists(ExePath & "SquidSaver.dat") Then Using Sr As StreamReader = _ New StreamReader(ExePath & "SquidSaver.dat", System..Encoding.Default) DispMes = Sr.ReadLine() S = Sr.ReadLine() : ScrType = Integer.Parse(S) S = Sr.ReadLine() : CharMax = Integer.Parse(S) Sr.Close() End Using DispMes = "" : ScrType = 0 : CharMax = 50 Using Sw As StreamWriter = _ New StreamWriter(ExePath & "SquidSaver.dat", False, System..Encoding.Default) Sw.WriteLine(DispMes) Sw.WriteLine(ScrType) Sw.WriteLine(CharMax) Sw.Close() End Using ' テスト用 (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" Select Case P Case "/c" -9-
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 Frm.BackColor = Color.FromArgb(255, 0, 128, 255) ' フォームのモーダル表示 Frm.ShowDialog() Exit Sub Exit Sub Case Dim Frm As Form = New frmcnfg() Frm.ShowDialog() Exit Sub End Select ' 通常のアプリケーションを Sub Main から起動なら下記の様にする 'Dim Frm As Form = New frmscr() 'Frm.Show() 'Application.Run(Frm) ' 二重起動を検証するジェネラルプロシージャ Public Function PrevInstance() As Boolean If UBound(Diagnostics.Process.GetProcessesByName( _ Diagnostics.Process.GetCurrentProcess.ProcessName)) > 0 Then Return True Return False -10-
End Function End Module -11-