ドライブは安全運転で in 滋賀♪

Size: px

Start display at page:

Download "ドライブは安全運転で in 滋賀♪"

あおしはかまや
5 years ago
Views:

烏賊セーバー VB 2005 71 プログラムの概要可愛い烏賊が画面を泳ぐスクリーンセーバーで有る烏賊の数背景 ( 黒一色かデスクトップ画面 ) を設定する事が出来る背景が黒一色の場合は単に烏賊が左右から現れては反対側に泳いで行く丈だがデスクトップ画面の場合は徐々に背景が烏賊の形に塗り潰されて行くスクリーンセーバーの本来の目的はディスプレイの焼き付きを防止する事で有るが

1 烏賊セーバー VB プログラムの概要可愛い烏賊が画面を泳ぐスクリーンセーバーで有る烏賊の数背景 ( 黒一色かデスクトップ画面 ) を設定する事が出来る背景が黒一色の場合は単に烏賊が左右から現れては反対側に泳いで行く丈だがデスクトップ画面の場合は徐々に背景が烏賊の形に塗り潰されて行くスクリーンセーバーの本来の目的はディスプレイの焼き付きを防止する事で有るが現在ではブラウン管式のディスプレイは殆ど観掛けず液晶式のディスプレイでは此の事に余り拘る必要は無く観て楽しい物が主流で有る猶 Visual Basic 2005 Express にはスクリーンセーバーキットが有り簡単にスクリーンセーバーを作成する事が出来る一般的に実用プログラムに比較するとゲームプログラムは高度なテクニックを要求される事が多い此処ではゲームプログラムを作成する事に依り楽しみ乍らプログラムの制作手順を習得する事を目的として居る制作手順としては実際の作業過程に従い段階的に機能を追加する方法を採用して居る此のプログラムを土台に更に各自で機能を追加して行く事が望まれる今回の課題項目アプリケーション画面のデザイン ( 標準コントロールの利用 ) プログラムの動作原理 ( イベント駆動型のプログラム ) プログラムの構成要素 ( オブジェクトとプロパティ ) 値の代入 ( 変数オブジェクトのプロパティ ) グラフィックスの利用 (Graphics オブジェクト ) 条件に応じた処理 (If 文の利用 ) 自動的に行われる処理 ( タイマーの利用 ) -1-

オブジェクトプロパティ一覧メイン画面用ピクチャボックスラベルタイマーコントロールの種類プロパティプロパティの設定値フォーム Name frmscr BackColor 0, 128, 255 FormBorderStyle None KeyPreview True WindowState Maximized ラベル Name

2 オブジェクトプロパティ一覧メイン画面用ピクチャボックスラベルタイマーコントロールの種類プロパティプロパティの設定値フォーム 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

設定画面用コントロールの種類プロパティプロパティの設定値フォーム Name frmcnfg FormBorderStyle FixedSingle Icon アイコン.ico StartPosition CenterScreen Squid Saver Setup グループボックス Name grpmessage MS 明朝, 12.0!

3 設定画面用コントロールの種類プロパティプロパティの設定値フォーム 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-

4 プログラムリスト 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-

5 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-

6 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 = 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-

7 ' 移動して居る場合 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-

8 ' ファイルに現在の設定を保存 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-

9 ' 設定値の取得 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-

10 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-

11 End Function End Module -11-

ウォームアップ　61-70

ウォームアップ　61-70 烏賊セーバー VB 2005 71 プログラムの概要可愛い烏賊が画面を泳ぐスクリーンセーバーで有る烏賊の数背景 ( 黒一色かデスクトップ画面 ) を設定する事が出来る背景が黒一色の場合は単に烏賊が左右から現れては反対側に泳いで行く丈だがデスクトップ画面の場合は徐々に背景が烏賊の形に塗り潰されて行くスクリーンセーバーの本来の目的はディスプレイの焼き付きを防止する事で有るが現在では