はじめに
私がかつてVector様のサイトにて公開しておりました
『メニューソフト(対数螺旋版)』の内部コードの主要部分を
紹介させて頂こうと思います。
今回紹介させていただくコードでどのように動作するかは
以下のニコニコ動画の内容か
『『聖剣伝説3』の「リングコマンド」的なランチャーを作ってみた』
https://www.nicovideo.jp/watch/sm22173687
ツイート内の動画をご参照ください。
かつて公開していた『メニューソフト(対数螺旋版)』の内部の主要コードをQiitaでの公開に向けて作っています。尚、ソフトはWindows10の1703あたり？でキーのHook等の動作が不安定になったので、公開を停止しております。SFCの聖剣伝説3のリングコマンドを参考に作ったものでした、、、 pic.twitter.com/2oXaeRY9bp
— TageSP (@oyk3865b) May 21, 2020
私事ですが
紹介のソフトを作成した理由は、小学生の頃
スーパーファミコンの聖剣伝説3というソフトにハマっていまして
それを参考にしたメニューを作ってみたいと思い立って
作成いたしました。
尚、聖剣伝説3は、最近リメイクされ
そのリメイク中でもメニューは登場しますが
スーパーファミコンのものと違って
アイコンが画面いっぱいに広がる感じがない仕様になっていました。
また、現在公開を停止させて頂いている理由は、
WindowsキーをHookする仕様だったのですが
Windows10 1703に更新されたあたりから
Hookまわりの動作が不安定になったため、停止いたしました。
そして、下記のコードでは、Hookまわりは消していて
直接、メニューが開く仕様となっています。
Hookまわりがないと、特に動作が不安定になったりは致しておりません。
また、キーボードのHookを取り除いたので、マウスだけで動くことになりました。
以上
何かの参考になれば幸いでございます。
#動作方法に関して
**1.**今回は、画面の中央を中心として楕円があり
その楕円の円周に、アイコンを等間隔に配置している状態が基本となります。
**2.**ソフトを開いた際は、
その基本の位置に向かって、対数螺旋を描いて、
アイコンが画面枠外から登場するようにしていて
**3.**アイコンの配置後は、マウスホイールで
アイコンをくるくると回して、選択を行います。
今回は、アイコンは楕円の円周を全てくるくる回っているのではなく、
隣のアイコンの手前の位置までの円弧を動いた後、
隣のアイコンと中身を入れ替えて、回っているように見せかける仕様としています。
4.左クリックにて、最も画面上にあり、
枠で囲まれたアイコンの内容が開きます。
5.右クリックにて、別のメニューに切り替わります。
6.マウスホイールを押して終了した場合や
何かのアイコンを開いた場合は、
ソフトを開いた際との逆の対数螺旋を描いて
アイコンが画面外へと飛んでいきます。
**7.**上記の動作の為に必要な効果音は、
今回は、ネット空間からexeと同階層にダウンロードして使用する仕様です。
また、必要な画像、アイコンも、都度ネット空間からダウンロードして使用する仕様です。
このため特に初回動作の立ち上がりが遅いです。
注意点
今回のコードは、公開用に内容を最低限にまで絞っているので
動作保証は致しません。
また、解放などが不十分となっております。
そして、描画の為に、ある程度高いPCスペックを要求します。
非力なパソコンでは、もっさりとした動作になると思います。
また、exeと同階層にサブフォルダが存在した場合
そのサブフォルダの内容を表示することを優先にしていますが
サブフォルダがない場合は、仮の項目を作成して表示するようにしています。
コードに関して(Form1)
Visual Studio 2019の新規プロジェクト作成にて
Visual Basicでの「Windowsフォームアブケーション」を選択し
初期で備わっているForm1には、
以下のコードを記述します。
この中で、別に必要なFormは動的に作成いたしております。
Form1.vb
Imports System.IO
Imports System.Net
Public Class Form1
Private Sub frmBackGround_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
Try '安全装置
Me.DestroyHandle()
Me.Dispose()
Catch ex As Exception
End Try
End Sub
Private Sub frmBackGround_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
Try '最前面の解除
Me.TopMost = False
'安全装置(各・解放)
If Image_Timer IsNot Nothing Then
Image_Timer.Enabled = False
Image_Timer.Dispose()
Image_Timer = Nothing
End If
If Round_Timer IsNot Nothing Then
Round_Timer.Enabled = False
Round_Timer.Dispose()
Round_Timer = Nothing
End If
If RoundChange_Timer IsNot Nothing Then
RoundChange_Timer.Enabled = False
RoundChange_Timer.Dispose()
RoundChange_Timer = Nothing
End If
If End_Timer IsNot Nothing Then
End_Timer.Enabled = False
End_Timer.Dispose()
End_Timer = Nothing
End If
'各オブジェクトの解放
If info_name IsNot Nothing Then info_name.Clear()
info_name = Nothing
If info_path IsNot Nothing Then info_path.Clear()
info_path = Nothing
Catch ex As Exception
End Try
End Sub
'終了監視タイマー
Dim End_Timer As Timer
'frmMain起動時のバグを防ぐためのタイマー
Dim Form1_Start_Timer As Timer
Dim Form1_Start_Timer_Moving_Flg As Boolean
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'ここから始まる・・・。
Try
Me.Text = Application.ProductName & " " & My.Application.Info.Version.ToString
Catch ex As Exception
'リソース読込失敗時→アイコンそのまま
Me.Text = "メニューソフト(対数螺旋版)"
End Try
'デバッグ用
open_Flg = 1
'今回はデモ用なのでネット空間の音をあらかじめ取り込んでおく
ReDim wav_st(3)
For i As Integer = 0 To 3
Dim fff As String = ""
Select Case i
Case 0
fff = "http://oyk3865b.web.fc2.com/wave/turn.wav"
Case 1
fff = "http://oyk3865b.web.fc2.com/wave/close.wav"
Case 2
fff = "http://oyk3865b.web.fc2.com/wave/open2.wav"
Case 3
fff = "http://oyk3865b.web.fc2.com/wave/change.wav"
End Select
wav_st(i) = IO.Path.Combine(App_Path, fff.Substring(fff.LastIndexOf("/") + 1))
'取り込まれていない場合はDLしておく
If Not IO.File.Exists(wav_st(i)) Then
Using wc As New System.Net.WebClient()
wc.DownloadFile(fff, wav_st(i))
End Using
Application.DoEvents()
End If
Next
Using wc As New WebClient()
Using st As Stream = wc.OpenRead("https://blog-imgs-138.fc2.com/o/y/k/oyk3865b/CustomBackGround.png")
BackGroundImage_bmp = New Bitmap(st) '→モデル画像を、格納
End Using
End Using
'描画停止
Me.Visible = False
Me.SuspendLayout()
'背景となるので、フルスクリーン表示する
'http://www.atmarkit.co.jp/fdotnet/dotnettips/199fullscreen/fullscreen.html
Me.BackColor = frmHaikei_BackColor '背景色を設定
'背景の透過率を設定
Me.Opacity = 0 '背景を一旦完全な透明にする。
' 1. フォームの境界線スタイルを「None」にする
Me.FormBorderStyle = FormBorderStyle.None
' 2. フォームのウィンドウ状態を「最大化」する
Me.Left = 0 : Me.Top = 0
Me.Width = System.Windows.Forms.Screen.GetBounds(Me).Width
Me.Height = System.Windows.Forms.Screen.GetBounds(Me).Height
'Me.Width = 300 '画面サイズを指定する場合
'Me.Height = 300
Application.DoEvents()
'最小化状態から、回復する。
Me.WindowState = FormWindowState.Normal
'描画再開
Application.DoEvents()
Me.ResumeLayout()
Me.Visible = True
Application.DoEvents()
'終了監視用タイマーの設定
End_Timer = New Timer() 'タイマーオブジェクトの設定
AddHandler End_Timer.Tick, New EventHandler(AddressOf End_Timer_Tick) 'イベントを指定
End_Timer.Interval = Timer_Interval '動作間隔
End_Timer.Enabled = True '実行開始
'★直接やると表示がおかしくなるorz
'→そこで、タイマーを呼び出して、処理させる。
Try
'開始動作タイマーを呼び出して、別処理させる。
'http://www.lasical.com/2011/02/22/1227/
Form1_Start_Timer = New Timer() 'タイマーオブジェクトの設定
AddHandler Form1_Start_Timer.Tick, New EventHandler(AddressOf Do_Form1_Start_Timer_Tick_Sub) 'イベントを指定
Form1_Start_Timer.Interval = Timer_Interval '動作間隔
Form1_Start_Timer.Enabled = True '実行開始
Application.DoEvents()
Catch ex As Exception
'エラー時
End Try
End Sub
Private Sub End_Timer_Tick()
'終了の監視を行う
'正常に閉じる指令を与えるフラグになった場合
If open_Flg = 6 Then
'終了していますよ。というフラグ
open_Flg = 7
'まず、タイマーの解放
If End_Timer IsNot Nothing Then
End_Timer.Enabled = False
End_Timer.Dispose()
End If
End_Timer = Nothing
'描画画面を閉じる
frmMain.Close()
'次に、本体を閉じる
Me.Close()
End If
End Sub
Private Sub Do_Form1_Start_Timer_Tick_Sub()
'タイマーを呼び出して、背景透過の際に、つかみっぱなしになるのを、防ぐ
Try '開始動作タイマー動作開始フラグを上げる
Form1_Start_Timer_Moving_Flg = True
'まず、タイマーの解放
Form1_Start_Timer.Enabled = False
Form1_Start_Timer.Dispose()
Form1_Start_Timer = Nothing
'最前面表示にする。
'フォーカスを背景Formに移す
Me.TopMost = True
Me.Activate()
Call AllowSetForegroundWindow(CType(System.Diagnostics.Process.GetCurrentProcess().Id, IntPtr))
'当初の最前面の窓を自分の後ろ位置に移動させる
Call SetForegroundWindow(Me.Handle)
Me.BringToFront()
Me.Focus()
'メインフォームの設定
frmMain = New Form
With frmMain
.Owner = Me '親を背景Formに指定
'サイズ設定
.Width = Me.Width
.Height = Me.Height
'イベント関係
AddHandler .Load, AddressOf frmMain_Load
AddHandler .FormClosed, AddressOf frmMain_FormClosed
AddHandler .FormClosing, AddressOf frmMain_FormClosing
AddHandler .MouseDown, AddressOf frmMain_MouseDown
AddHandler .MouseWheel, AddressOf frmMain_MouseWheel
.FormBorderStyle = FormBorderStyle.None ' 1. フォームの境界線スタイルを「None」にする
.BackColor = frmHaikei_Transparency_Color '透過色の設定
.TransparencyKey = frmHaikei_Transparency_Color '透明を指定する
.Show()
.Location = New Point(
.Owner.Location.X + (.Owner.Width - .Width) \ 2,
.Owner.Location.Y + (.Owner.Height - .Height) \ 2) '位置の設定
Application.DoEvents()
End With
Catch ex As Exception
End Try
Try
'背景の透過率を設定
Me.Opacity = BackGround_Opacit_Value
'フォームをアクティブにする
Me.Activate()
Catch ex As Exception
End Try
'開始動作タイマー動作開始フラグを下げる
Form1_Start_Timer_Moving_Flg = False
End Sub
Private Sub frmBackGround_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
'マウスダウンイベントの捕捉
'マウスダウンイベントの捕捉
Dim key_up_down As Keys = Keys.Up '初期は↑キー
If e.Button = MouseButtons.Right Then
'右クリック→項目群の交換(Mouse_Button_Flg = 1だと、意味が左クリック時と、反転。)
Call KeyDown_Check(If(Mouse_Button_Flg <> 1, key_up_down, Keys.Enter))
ElseIf e.Button = MouseButtons.Left Then
'右クリック→決定(Mouse_Button_Flg = 1だと、意味が左クリック時と、反転。)
Call KeyDown_Check(If(Mouse_Button_Flg <> 1, Keys.Enter, key_up_down))
ElseIf e.Button = MouseButtons.Middle Then
'マウスホイールを押下げ→ESC
Call KeyDown_Check(Keys.Escape)
End If
End Sub
Private Sub frmBackGround_MouseWheel(sender As Object, e As MouseEventArgs) Handles Me.MouseWheel
'マウスホイールをくるくるした時
'https://www.umayadia.com/vbsample/dotnet-Samples151/Sample180MouseWheel.htm
If e.Delta > 0 Then
'上方向
Call KeyDown_Check(Keys.Right)
Else '下方向
Call KeyDown_Check(Keys.Left)
End If
End Sub
Private Sub frmMain_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs)
Try
Me.DestroyHandle()
Me.Dispose()
Catch ex As Exception
End Try
End Sub
Private Sub frmMain_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs)
'解放
Try
'自Form内のすべてのコントロールを列挙する
For Each picbox As Object In Me.Controls
If TypeOf picbox Is PictureBox Then
Try 'PictureBoxの場合→解放する。
If picbox IsNot Nothing Then
If CType(picbox, PictureBox).Image IsNot Nothing Then CType(picbox, PictureBox).Image.Dispose()
CType(picbox, PictureBox).Image = Nothing
If picbox IsNot Nothing Then CType(picbox, PictureBox).Dispose()
picbox = Nothing
End If
Catch ex As Exception
End Try
End If
Next picbox
If picMain IsNot Nothing AndAlso (Not picMain.IsDisposed) Then
'動的に、各・イベントを解放する
RemoveHandler picMain.Paint, AddressOf picMain_Paint
RemoveHandler picMain.MouseDown, AddressOf frmMain_MouseDown
'RemoveHandler picMain.MouseWheel, AddressOf Label3_MouseWheel
picMain.Dispose()
End If
picMain = Nothing
If pic_obj IsNot Nothing Then
Try
For Each obj As Bitmap In pic_obj
Try
If obj IsNot Nothing Then obj.Dispose()
obj = Nothing
Catch ex As Exception
End Try
Next
pic_obj.Clear()
Catch ex As Exception
End Try
End If
pic_obj = Nothing
imgWakuLT.Dispose()
imgWakuRT.Dispose()
imgWakuLB.Dispose()
imgWakuRB.Dispose()
If PictureBox1 IsNot Nothing Then PictureBox1.Dispose()
PictureBox1 = Nothing
If Label1 IsNot Nothing Then Label1.Dispose()
Label1 = Nothing
If Label2 IsNot Nothing Then Label2.Dispose()
Label2 = Nothing
If Label3 IsNot Nothing Then Label3.Dispose()
Label3 = Nothing
Catch ex As Exception
End Try
End Sub
Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs)
Try
Me.Text = Application.ProductName & " " & My.Application.Info.Version.ToString
Catch ex As Exception
'リソース読込失敗時→アイコンそのまま
Me.Text = "メニューソフト(対数螺旋版)"
End Try
'画面のちらつき防止
'http://ykmtblog.hatenablog.jp/entry/2012/10/02/190127
Me.DoubleBuffered = True
Me.SetStyle(ControlStyles.UserPaint, True)
Me.SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True)
'http://www.atmarkit.co.jp/fdotnet/dotnettips/194nopaintbg/nopaintbg.html
Me.SetStyle(ControlStyles.Opaque, True)
'ラベルの設置
Label1 = New Label
Me.Controls.Add(Label1)
Label1.TextAlign = ContentAlignment.MiddleCenter
Label2 = New Label
Me.Controls.Add(Label2)
Label2.TextAlign = ContentAlignment.MiddleCenter
Label3 = New Label
Me.Controls.Add(Label3)
Label3.TextAlign = ContentAlignment.MiddleCenter
'ベース用のPictureBoxの配置
PictureBox1 = New PictureBox
Me.Controls.Add(PictureBox1)
PictureBox1.SizeMode = PictureBoxSizeMode.Zoom
PictureBox1.Width = PictureBox1_Width
PictureBox1.Height = PictureBox1_Height
PictureBox1.Visible = False
'描画メイン用のPictureBoxの配置
picMain = New PictureBox
Me.Controls.Add(picMain)
picMain.Dock = DockStyle.Fill '全画面表示
picMain.Visible = True
'動的に、各・イベントを関連付ける
AddHandler picMain.Paint, AddressOf picMain_Paint
AddHandler picMain.MouseDown, AddressOf frmMain_MouseDown
'■画面に合わせてサイズの更新(小さい場合のみ)
'フォームのあるディスプレイの大きさを取得する
Dim h_w_size As Integer = Me.Height
If h_w_size > Me.Width Then h_w_size = Me.Width 'サイズの小さいほうをとる
Using wc As New WebClient()
'ネット上の画像を取り込む
Using st As Stream = wc.OpenRead("https://blog-imgs-138.fc2.com/o/y/k/oyk3865b/wktk.png")
If h_w_size < 700 AndAlso h_w_size > 96 Then
'指定より小さい場合(且つ、小さすぎない場合)
PictureBox1.Width = h_w_size \ 16 : PictureBox1.Height = h_w_size \ 16
Label2.Font = New Font(Label2.Font.Name, h_w_size \ 96)
Label3.Font = New Font(Label3.Font.Name, h_w_size \ 85)
Label1.Font = New Font(Label1.Font.Name, h_w_size \ 54, FontStyle.Bold)
If imgWakuLT IsNot Nothing Then imgWakuLT.Dispose()
imgWakuLT = Nothing
Using bmp As New Bitmap(st)
imgWakuLT = New Bitmap(bmp, h_w_size \ 26, h_w_size \ 29)
End Using
imgWaku_pos16 = h_w_size \ 48
imgWaku_pos12 = CInt(imgWaku_pos16 * 0.75)
imgWaku_pos8 = CInt(imgWaku_pos16 * 0.5)
Else '大きな画面の場合
imgWakuLT = New Bitmap(st)
imgWaku_pos16 = 16 '正常値を入れる
imgWaku_pos12 = 12
imgWaku_pos8 = 8
End If
End Using
End Using
PictureBox1.Visible = False
Try '位置設定周り
Label1.Left = Me.Width \ 4
Label1.Width = Me.Width \ 2
Label1.Top = Me.Height \ 16
Label1.Height = Me.Height \ 16
Label1.BackColor = Label1_BackColor
Label1.ForeColor = Label1_ForeColor
Label1.Font = Label1_Font
Label2.Left = Me.Width \ 4
Label2.Width = Me.Width \ 2
Label2.Top = CInt(Me.Height * 0.89)
Label2.Height = CInt(Me.Height * 0.09)
Label2.BackColor = Label2_BackColor
Label2.ForeColor = Label2_ForeColor
Label2.Font = Label2_Font
Label3.Left = Me.Height \ 32
Label3.Width = Me.Width \ 8
Label3.Top = Me.Height \ 32
Label3.Height = Me.Height \ 24
Label3.BackColor = Label3_BackColor
Label3.ForeColor = Label3_ForeColor
Label3.Font = Label3_Font
'説明文の記述
Label2.Text = "■操作説明■" & Environment.NewLine & If(Mouse_Button_Flg <> 1, "左", "右") & "クリック = 決定 / マウスホイール押し下げ = 閉じる " & Environment.NewLine &
"マウスホイール = 選択 / " & If(Mouse_Button_Flg <> 1, "右", "左") & "クリック = 項目群の切り替え"
'"※exeと同階層にあるフォルダの中身を、25項目までに限り表示＆選択するだけの開発中のソフトです。"
Catch ex As Exception
End Try
'各画像オブジェクトを、格納
pic_obj = New List(Of Bitmap)
info_name = New List(Of String)
info_path = New List(Of String)
'0項目の終点位置を再格納
End_pos_Left = ((Me.Width - PictureBox1.Width) \ 2)
End_pos_Top = ((Me.Height - PictureBox1.Height) \ 4)
'■同階層のリンクフォルダの項目を取得
'同階層のフォルダの数を取得
Dim link_Folder_Count() As String = System.IO.Directory.GetDirectories(
App_Path, "*", System.IO.SearchOption.TopDirectoryOnly)
RoundChange_No_Flg = If(RoundChange_No_Flg > link_Folder_Count.Length - 1 Or RoundChange_No_Flg < 0,
0, RoundChange_No_Flg)
If link_Folder_Count.Length <= 0 Then
'有効なサブフォルダのない場合→代用する
Call Non_Link_File_Sub()
Else '有効なサブフォルダがある正常時
'→今回の取得フォルダを得る
Dim link_Folder_Path As String = link_Folder_Count(RoundChange_No_Flg)
If IO.Directory.Exists(link_Folder_Path) Then
'フォルダが、真に存在する場合
'→内部の取得を試みる
Dim ary As New ArrayList
ary.AddRange(System.IO.Directory.GetFiles(
link_Folder_Path, "*", System.IO.SearchOption.TopDirectoryOnly))
ary.AddRange(System.IO.Directory.GetDirectories(
link_Folder_Path, "*", System.IO.SearchOption.TopDirectoryOnly))
'ファイルリストを得る
Dim link_files() As String = DirectCast(ary.ToArray(GetType(String)), String())
ary.Clear() : ary = Nothing
If link_files.Length <= 0 Then
'有効なリンク指定がない場合
Call Non_Link_File_Sub()
Else '★有効なリンクがあった場合
'→その情報を読み込む
Call Get_Link_FileInfo_Sub(link_files)
End If
Else '有効なリンク指定がない場合
Call Non_Link_File_Sub() '→代用する
End If
End If
'四隅の枠の画像を回転して自作する
'http://dobon.net/vb/dotnet/graphics/rotateflip.html
imgWakuRT = New Bitmap(imgWakuLT)
imgWakuRT.RotateFlip(RotateFlipType.Rotate180FlipY)
imgWakuLB = New Bitmap(imgWakuLT)
imgWakuLB.RotateFlip(RotateFlipType.Rotate180FlipX)
imgWakuRB = New Bitmap(imgWakuLT)
imgWakuRB.RotateFlip(RotateFlipType.Rotate180FlipNone)
'移動方向を、設置に設定
Set_Out_Flg = True
'値の初期化
pos = max_pos
If Not No_SoundEffect_Flg Then '効果音を鳴らす場合
'別スレッドで音を鳴らす
Call Sound_Play_Thread("open")
End If
'タイマーを呼び出して、 リング作成動作処理させる。
Image_Timer = New Timer() 'タイマーオブジェクトの設定
AddHandler Image_Timer.Tick, New EventHandler(AddressOf Do_Image_Timer_Tick_Sub) 'イベントを指定
Image_Timer.Interval = Timer_Interval '動作間隔
Image_Timer.Enabled = True '実行開始
Application.DoEvents()
End Sub
Private Sub picMain_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs)
'描画する所
Try '安全装置
If picMain Is Nothing Then Exit Sub
If picMain.IsDisposed Then Exit Sub
If e Is Nothing Then Exit Sub
If open_Flg >= 6 Then Exit Sub
If Round_Timer IsNot Nothing Then
'回転の描画
Call picMain_Round_Paint(e.Graphics)
ElseIf Image_Timer IsNot Nothing Then
'動作開始&終了時の描画
Call picMain_Start_End_Paint(e.Graphics)
ElseIf RoundChange_Timer IsNot Nothing Then
'回転して項目を入れ替える
Call picMain_RoundChange_Paint(e.Graphics)
ElseIf Normal_Timer IsNot Nothing AndAlso open_Flg < 5 Then
'待機状態での描画(且つ、終了信号が出ていない場合)
'通常時の描画をさせる
pos = -180
Call picMain_Round_Paint(e.Graphics)
ElseIf Normal_Flg AndAlso open_Flg < 5 Then
'平常時の描画開始の合図の場合(且つ、終了信号が出ていない場合)
Normal_Timer = New Timer() 'タイマーオブジェクトの設定
AddHandler Normal_Timer.Tick, New EventHandler(AddressOf Do_Image_Timer_Tick_Sub) 'イベントを指定
Normal_Timer.Interval = Timer_Interval '動作間隔
Normal_Timer.Enabled = True '実行開始
'通常時の描画をさせる
pos = -180
Call picMain_Round_Paint(e.Graphics)
End If
Catch ex As Exception
'エラー時
'→無視
End Try
End Sub
Private Sub frmMain_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
'マウスダウンイベントの捕捉
Dim key_up_down As Keys = Keys.Up '初期は↑キー
If e.Button = MouseButtons.Right Then
'右クリック→項目群の交換(Mouse_Button_Flg = 1だと、意味が左クリック時と、反転。)
Call KeyDown_Check(If(Mouse_Button_Flg <> 1, key_up_down, Keys.Enter))
ElseIf e.Button = MouseButtons.Left Then
'右クリック→決定(Mouse_Button_Flg = 1だと、意味が左クリック時と、反転。)
Call KeyDown_Check(If(Mouse_Button_Flg <> 1, Keys.Enter, key_up_down))
ElseIf e.Button = MouseButtons.Middle Then
'マウスホイールを押下げ→ESC
Call KeyDown_Check(Keys.Escape)
End If
End Sub
Private Sub frmMain_MouseWheel(sender As Object, e As MouseEventArgs)
'マウスホイールをくるくるした時
'https://www.umayadia.com/vbsample/dotnet-Samples151/Sample180MouseWheel.htm
If e.Delta > 0 Then
'上方向
Call KeyDown_Check(Keys.Right)
Else '下方向
Call KeyDown_Check(Keys.Left)
End If
End Sub
End Class
#コードに関して(Module1)
続けて、メニューバーの「プロジェクト」より
モジュールの追加を行い
作成されたModule1の内部には、以下のように記述いたします。
Module1.vb
'回転やアイコンの動作をつかさどる所
Imports System.IO
Imports System.Net
Imports System.Runtime.InteropServices
Module mod動作用
'自パスを格納
Public ReadOnly App_Path As String = System.IO.Path.GetDirectoryName(
System.Reflection.Assembly.GetExecutingAssembly().Location)
'メイン画面用フォームを動的に作成して格納
Public frmMain As Form = Nothing
'アイコンの移動計量用
Public max_pos As Integer = 100
Public pos As Integer = max_pos
'アイコン画像オブジェクト格納用
Public pic_obj As List(Of Bitmap) = Nothing
'アイコンと同期させる情報オブジェクト格納用
Public info_name As List(Of String) = Nothing '項目の名称を格納
Public info_path As List(Of String) = Nothing '絶対パスを格納
'ロード時(True)または、終了時(False)フラグ
Public Set_Out_Flg As Boolean = True
'画像動作処理の際に、タイマーで別プロシージャ処理させる。
Public Image_Timer As Timer
'タイマー重複防止用フラグ
Public Image_Timer_Tick_Flg As Boolean = False
'リングのベース用PicutureBox
Public picMain As PictureBox
'リングの描画用PicutureBox
Public PictureBox1 As PictureBox
Public Const PictureBox1_Width As Integer = 48
Public Const PictureBox1_Height As Integer = 48
'リング描画の下地となる透過画像
Public BackGroundImage_bmp As Bitmap
'アイコンの動作位置調整用
Public End_pos_Left As Integer = PictureBox1_Width
Public End_pos_Top As Integer = PictureBox1_Height
'仮想x,y座標位置を格納
Public x_location As Integer = 0
Public y_location As Integer = 0
'一回転は、360度であるよ。
Public ReadOnly round_theta As Integer = 360
'平常時のタイマー。
Public Normal_Timer As Timer
Public Normal_Flg As Boolean = False '平常時かどうかを格納する
'タイマーの動作間隔
Public ReadOnly Timer_Interval As Integer = CInt(1000 \ 60) '60fps
'四隅の枠の画像を格納
Public imgWakuLT As Bitmap = Nothing
Public imgWakuRT As Bitmap = Nothing
Public imgWakuLB As Bitmap = Nothing
Public imgWakuRB As Bitmap = Nothing
'リングのまわりの情報表示用ラベル
Public Label1 As Label
Public Label2 As Label
Public Label3 As Label
'一つのリングで扱える最大項目数
Const Max_Use_Link_Count = 26
'効果音再生用プレーヤー
'http://dobon.net/vb/dotnet/programing/playwavfile.html
Public wav_player As System.Media.SoundPlayer = Nothing
'再生するwaveへのパスを格納
Public wav_st() As String
'リングの現状を示すフラグ
Public open_Flg As Integer = 0
'最後に扱った項目の名称を格納[※今回は保存してない]
Public Last_List_Index As String = ""
'左右クリックボタンの交換をするかどうか
Public Mouse_Button_Flg As Integer = 0 '0は、しない。
'左右キーボタンの交換をするかどうか
Public Left_Right_Key_Flg As Integer = 0 '0は、しない。
'直接読み取るかの境界となる画像のファイルサイズ
Public Image_Border_FileSize As Integer = 500 '0は、しない。
'説明文を、表示するかどうか
Public Label2_Visible_Flg As Boolean = True
'効果音をなくすかどうか
Public No_SoundEffect_Flg As Boolean = False
'タイムアウト時間の格納(ms)
Public TimeOut_mSec As Integer = 7000
'リング回転時の動作速度
Public Round_move_span As Integer = 12
'ソフト起動・終了時の動作速度
Public Open_move_span As Integer = 5
'背景の透過率を格納
Public BackGround_Opacit_Value As Double = 0.88
'リンクがない場合は表示する項目を交互に違う物にする
Dim Non_Link_File_Switch As Byte = 0
'ソフト全体の背景色
Public frmHaikei_BackColor As Color = Color.Black
'ソフト全体の透過色(固定値)
Public ReadOnly frmHaikei_Transparency_Color As Color = ColorTranslator.FromWin32(&HC0C0C1&) '透過色の設定
'Label1(選択項目)の背景色
Public Label1_BackColor As Color = Color.Bisque
Public Label1_ForeColor As Color = Color.SaddleBrown
Public Label1_Font As Font = New Font("MS UI Gothic", 14, FontStyle.Bold)
'Label2(説明文)の背景色
Public Label2_BackColor As Color = Color.Bisque
Public Label2_ForeColor As Color = Color.SaddleBrown
Public Label2_Font As Font = New Font("MS UI Gothic", 8, FontStyle.Regular)
'Label3(項目群)の背景色
Public Label3_BackColor As Color = Color.Ivory
Public Label3_ForeColor As Color = Color.DarkSlateGray
Public Label3_Font As Font = New Font("MS UI Gothic", 9, FontStyle.Regular)
'指定されたウィンドウをアクティブウィンドウにする。
'http://oshiete.goo.ne.jp/qa/8163639.html
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As IntPtr) As Integer
Public Declare Function AllowSetForegroundWindow Lib "user32" (ByVal dwProcessId As IntPtr) As Integer
' SHGetFileInfo関数でアイコンを取得する。
Private Declare Ansi Function SHGetFileInfo Lib "shell32.dll" (ByVal pszPath As String, ByVal dwFileAttributes As Integer, ByRef psfi As SHFILEINFO, ByVal cbFileInfo As Integer, ByVal uFlags As Integer) As IntPtr
' SHGetFileInfo関数で使用するフラグ
Private Const SHGFI_ICON As Integer = &H100 ' アイコン・リソースの取得
Private Const SHGFI_LARGEICON As Integer = &H0 ' 大きいアイコン
Private Const SHGFI_SMALLICON As Integer = &H1 ' 小さいアイコン
' SHGetFileInfo関数で使用する構造体
Private Structure SHFILEINFO
Public hIcon As IntPtr
Public iIcon As IntPtr
Public dwAttributes As Integer
Public szDisplayName As String
Public szTypeName As String
End Structure
Public Sub Get_Link_FileInfo_Sub(ByVal files() As String)
'■各・項目を設定するルーチン。
'各・配列の初期化
If pic_obj IsNot Nothing Then pic_obj.Clear()
pic_obj = Nothing
pic_obj = New List(Of Bitmap)
If info_name IsNot Nothing Then info_name.Clear()
info_name = Nothing
info_name = New List(Of String)
If info_path IsNot Nothing Then info_path.Clear()
info_path = Nothing
info_path = New List(Of String)
Dim err_flg As Integer = 200
If files Is Nothing OrElse files.Length <= 0 Then
'有効なファイルがない場合→代用する。
Call Non_Link_File_Sub()
Exit Sub '出る
End If
'★★ローカルのサブフォルダが存在する環境なら、そのサブフォルダの内部リストを優先する★★
Try
'項目数カウント用
Dim picBox_obj_count As Integer = 0
'画像変換用
Dim ic As New ImageConverter
Dim Max_ini_Size As Integer = (1024 * 50) '最大保存サイズ
For Each LnkFileName As String In files
'lnkファイルから、ショートカット先を辿る
Dim LnkFile As Object = Nothing
Dim FileName As String = LnkFileName 'ファイルバスを残しておく。(SHGetFileInfoを通すと変化する。)
Retry_Line:
If IO.Path.GetExtension(LnkFileName).ToLower = ".ico" OrElse
IO.Path.GetExtension(LnkFileName).ToLower = ".ini" Then
'※アイコンと、iniは、リストから除外
Continue For
End If
'ショートカット先から、アイコン画像を入手する
Dim shinfo As New SHFILEINFO()
Dim hSuccess As IntPtr = IntPtr.Zero '初期化
Dim Image_Link_Flg As Boolean = False '画像へのリンクかどうかのフラグ
'■生ファイルからアイコンを得る場合
From_Raw_File_Line:
hSuccess = SHGetFileInfo(LnkFileName, 0, shinfo, Marshal.SizeOf(shinfo), SHGFI_ICON Or SHGFI_LARGEICON)
'正常に取得できた場合
If Not hSuccess.Equals(IntPtr.Zero) Then
BASE64_Load_Line:
Try
'アイコンをハンドルから、取得する。
Dim appIcon As Icon = Nothing
If shinfo.hIcon = IntPtr.Zero AndAlso hSuccess <> IntPtr.Zero Then
'hSuccessから取得の場合
appIcon = Icon.FromHandle(hSuccess)
Else 'shinfo構造体から取得の場合
appIcon = Icon.FromHandle(shinfo.hIcon)
End If
'項目数を増やす
'http://homepage1.nifty.com/rucio/main/dotnet/shokyu/standard27.htm
Dim picBox_obj_bmp As Bitmap '(frmMain.PictureBox1.Width, frmMain.PictureBox1.Height)
If LnkFile IsNot Nothing AndAlso (Not Image_Link_Flg) Then
Iconic_Err_Line: 'ピクチャーボックスにリンク先のアプリケーション・アイコンをセット
picBox_obj_bmp = appIcon.ToBitmap()
Else 'アイコンを画像から得る場合
Select Case IO.Path.GetExtension(FileName).ToLower
Case ".jpg", ".jpeg", ".gif", ".png", ".bmp"
'◎画像の場合は、アイコンより画像を優先
Try '画像のサムネイルを、高速で作成する。
'http://www.atmarkit.co.jp/fdotnet/dotnettips/606fastthumbnail/fastthumbnail.html
Using fs As IO.FileStream = IO.File.OpenRead(FileName)
' 元画像の高速読み込み
Dim orig As Image = Image.FromStream(fs, False, False)
'Exif情報内のサムネイル・データの探索
Dim pils As Integer() = orig.PropertyIdList
Dim exif_index As Integer = Array.IndexOf(pils, &H501B)
If exif_index >= 0 Then 'サムネイルデータの存在する場合
'Exif情報内の、サムネイル・データの取得
Dim pi As System.Drawing.Imaging.PropertyItem = orig.PropertyItems(exif_index)
Dim jpgBytes As Byte() = pi.Value
' サムネイルの作成
Dim imgconv As New ImageConverter()
picBox_obj_bmp = CType(imgconv.ConvertFrom(jpgBytes), Bitmap)
GoTo GotThumbnail_Line
End If
'大きすぎるサイズの画像は、扱わない
If fs.Length >= 1024 * Image_Border_FileSize Then GoTo Iconic_Err_Line
'元画像から、アスペクト比が同じのサムネイル画像の作成
Dim width As Integer, height As Integer '幅／高さ
If orig.Width >= orig.Height Then
'横長の画像の場合
width = PictureBox1.Width
height = (width * orig.Height) \ orig.Width
Else '縦長の画像の場合
height = PictureBox1.Height
width = (height * orig.Width) \ orig.Height
End If
' サムネイルの取得
picBox_obj_bmp = New Bitmap(orig, width, height)
GotThumbnail_Line:
'元画像の解放
orig.Dispose()
fs.Close()
End Using
Catch ex As Exception '画像取得エラー時
GoTo Iconic_Err_Line
End Try
Case Else 'その他のファイルの場合
'ピクチャーボックスにアプリケーション・アイコンをセット
picBox_obj_bmp = appIcon.ToBitmap()
End Select
End If
'アイコンの解放
If appIcon IsNot Nothing Then appIcon.Dispose()
appIcon = Nothing
Try '画像を格納
If picBox_obj_bmp IsNot Nothing Then
pic_obj.Add(New Bitmap(scale_down_Image(picBox_obj_bmp)))
'名称情報も、格納
info_name.Add(IO.Path.GetFileNameWithoutExtension(FileName).Replace(" - ショートカット", "").Replace("へのショートカット", ""))
If LnkFile IsNot Nothing Then
'.lnkファイルの場合
'ショートカットのリンク先の絶対パスをも、格納
'http://wsh.style-mods.net/ref_wshshortcut/fullname.htm
info_path.Add(LnkFile.FullName)
Else '生ファイルの場合
info_path.Add(FileName) 'そのパスをそのまま格納
End If
'項目数をカウントアップ
picBox_obj_count += 1
End If
Catch ex As Exception
End Try
If picBox_obj_bmp IsNot Nothing Then picBox_obj_bmp.Dispose()
picBox_obj_bmp = Nothing
Catch ex As Exception
'エラー時
End Try
End If
'解放
LnkFile = Nothing
'最大項目数を超えた場合→出る
If picBox_obj_count > Max_Use_Link_Count Then Exit For
Next
'解放
ic = Nothing
Catch ex As Exception
'エラー時→代用する。
MessageBox.Show(err_flg.ToString & " : " & ex.Message, "Err", MessageBoxButtons.OK, MessageBoxIcon.Error)
If pic_obj Is Nothing OrElse pic_obj.Count <= 0 Then
Call Non_Link_File_Sub()
Exit Sub '出る
End If
End Try
'有効なファイルがなかった場合→代用する。
If pic_obj Is Nothing OrElse pic_obj.Count <= 0 Then
Call Non_Link_File_Sub()
Exit Sub '出る
End If
Try
If files.Length > 0 Then
'指定したパスから表示ディレクトリの名前を取得する
Label3.Text = System.IO.Directory.GetParent(files(0)).Name
Else '有効なファイルがない場合→数値で示す
Label3.Text = (RoundChange_No_Flg + 1).ToString
End If
Catch ex As Exception
End Try
End Sub
Public Sub Non_Link_File_Sub()
'有効なリンク指定がない場合の、代わりとなるオブジェクト代用Sub
'→仮の項目を入れる
Using wc As New WebClient()
'デモ用に仮のアイコンを交互に表示する
If Non_Link_File_Switch = 0 Then
'ネット上の画像を取り込む
Using st As Stream = wc.OpenRead("https://blog-imgs-49.fc2.com/o/y/k/oyk3865b/favicon.png")
pic_obj.Add(New Bitmap(scale_down_Image(New Bitmap(st)))) '→モデル画像を、格納
End Using
info_name.Add("～ Henry Le Chatelier ～") '名称情報も、格納
info_path.Add("http://oyk3865b.blog13.fc2.com/") 'リンク情報も、格納
'ネット上のアイコンを取り込む
Using st As Stream = wc.OpenRead("https://blog-imgs-36.fc2.com/o/y/k/oyk3865b/KC280014.ico")
pic_obj.Add(New Bitmap(scale_down_Image(New Bitmap(st)))) '→モデル画像を、格納
End Using
info_name.Add("つぶやき") '名称情報も、格納
info_path.Add("https://twitter.com/oyk3865b") 'リンク情報も、格納
'ネット上のアイコンを取り込む
Using st As Stream = wc.OpenRead("https://blog-imgs-62.fc2.com/o/y/k/oyk3865b/2013100615152118f.ico")
pic_obj.Add(New Bitmap(scale_down_Image(New Bitmap(st)))) '→モデル画像を、格納
End Using
info_name.Add("Google Playでの公開アプリ") '名称情報も、格納
info_path.Add("https://play.google.com/store/apps/developer?id=TageSP&hl=ja") 'リンク情報も、格納
'ネット上のアイコンを取り込む
Using st As Stream = wc.OpenRead("https://blog-imgs-138.fc2.com/o/y/k/oyk3865b/Folder8.jpg")
pic_obj.Add(New Bitmap(scale_down_Image(New Bitmap(st)))) '→モデル画像を、格納
End Using
info_name.Add("Vectorでの公開アプリ") '名称情報も、格納
info_path.Add("https://www.vector.co.jp/vpack/browse/person/an054966.html") 'リンク情報も、格納
'ネット上のアイコンを取り込む
Using st As Stream = wc.OpenRead("https://blog-imgs-138.fc2.com/o/y/k/oyk3865b/Folder5.jpg")
pic_obj.Add(New Bitmap(scale_down_Image(New Bitmap(st)))) '→モデル画像を、格納
End Using
info_name.Add("oyk3865b - Qiita") '名称情報も、格納
info_path.Add("https://qiita.com/oyk3865b") 'リンク情報も、格納
Else
'ネット上のアイコンを取り込む
Using st As Stream = wc.OpenRead("https://blog-imgs-138.fc2.com/o/y/k/oyk3865b/20200520214705c7c.ico")
pic_obj.Add(New Bitmap(scale_down_Image(New Bitmap(st)))) '→モデル画像を、格納
End Using
info_name.Add("TageSPのページ") '名称情報も、格納
info_path.Add("http://www.asint.jp/~oyk3865b/") 'リンク情報も、格納
Using st As Stream = wc.OpenRead("https://blog-imgs-138.fc2.com/o/y/k/oyk3865b/2016_01_17_31.ico")
pic_obj.Add(New Bitmap(scale_down_Image(New Bitmap(st)))) '→モデル画像を、格納
End Using
info_name.Add("TageSPの紹介ページ") '名称情報も、格納
info_path.Add("http://oyk3865b.web.fc2.com/Intro.html") 'リンク情報も、格納
Using st As Stream = wc.OpenRead("https://blog-imgs-138.fc2.com/o/y/k/oyk3865b/20200520214707c0d.ico")
pic_obj.Add(New Bitmap(scale_down_Image(New Bitmap(st)))) '→モデル画像を、格納
End Using
info_name.Add("メモ帳") '名称情報も、格納
'ローカルパスでのテスト
info_path.Add(IO.Path.Combine(System.Environment.GetFolderPath(System.Environment.SpecialFolder.Windows), "notepad.exe"))
End If
Non_Link_File_Switch = (Non_Link_File_Switch + 1) Mod 2
End Using
'項目群の番号を数値で示す
Label3.Text = (RoundChange_No_Flg + 1).ToString
End Sub
'リングの項目を回転しながら交換していく用タイマー。
Public RoundChange_Timer As Timer
Public RoundChange_Timer_Tick_Flg As Boolean = False '回転動作中フラグ
Dim RoundChange_location As Single = 1 '回転幅を狭くする。
Dim RoundChange_Reverse_Flg As Boolean = False '幅を狭くするか、広げるか
Public RoundChange_Next_Flg As Byte = 0 '次の項目群(1)か、前の項目(0)か、項目の削除(9)
Public RoundChange_No_Flg As Integer = 0 '現在の表示リスト番号を格納
Public Sub picMain_RoundChange_Paint(ByRef g As Graphics)
'回転して、別の項目へと変化させる。
'安全装置
If Image_Timer IsNot Nothing OrElse
RoundChange_Timer_Tick_Flg Then Exit Sub
'安全装置2
If picMain Is Nothing Then Exit Sub
If picMain.IsDisposed Then Exit Sub
If pic_obj Is Nothing Then Exit Sub
If g Is Nothing Then Exit Sub
'終了処理以降の場合→出る
If open_Flg >= 5 Then Exit Sub
'動作中フラグを上げる
RoundChange_Timer_Tick_Flg = True
'回転限界を算出
Dim stop_flg As Boolean = False
Dim err_flg As Integer = 500
'動作間隔を格納
Const move_span As Integer = 18 '180の約数でないといけない
Try
'回転を狭める幅を指定
Const press_sapn As Single = 0.05
If Not RoundChange_Reverse_Flg Then
'幅を狭める場合
RoundChange_location -= press_sapn
Else '幅を広げる場合
RoundChange_location += press_sapn
If RoundChange_location >= 1 Then
RoundChange_location = 1 '1以上には広げない
End If
End If
With frmMain
'右回り固定
pos = If(pos >= 0, -360, pos + move_span)
Dim Reset_Flg As Boolean = False
Reset_Line:
'各オブジェクトをループ
For i As Integer = pic_obj.Count - 1 To 0 Step -1 '末尾から描く
'安全装置
If pic_obj(i) Is Nothing Then Exit Sub
Dim theta As Integer = CInt((round_theta / pic_obj.Count) * i)
'最終的な角度を求める
theta = pos + theta - 180
err_flg = 501
'右回り固定
If (Not RoundChange_Reverse_Flg) AndAlso RoundChange_location <= 0 AndAlso (Not Reset_Flg) Then
'幅の圧縮が最大になった場合→停止
RoundChange_location = 0 '最後のつめるとき用
RoundChange_Reverse_Flg = True '今度は、広げる
If RoundChange_Next_Flg = 9 Then
'項目削除の場合
Call Delete_Folder_Link_Item() '先頭項目ファイルを消す
End If
'■項目を入れ替える
'同階層のフォルダの数を取得
Dim link_Folder_Count() As String = System.IO.Directory.GetDirectories(
App_Path, "*", System.IO.SearchOption.TopDirectoryOnly)
err_flg = 502
If link_Folder_Count Is Nothing OrElse link_Folder_Count.Length = 0 Then
'何も項目がない場合
Call Get_Link_FileInfo_Sub(Nothing)
Reset_Flg = True
GoTo Reset_Line 'やり直しさせる
End If
err_flg = 503
If RoundChange_Next_Flg = 1 Then
'次の項目群の場合
RoundChange_No_Flg = If(RoundChange_No_Flg >= link_Folder_Count.Length - 1 Or RoundChange_No_Flg < 0,
0, RoundChange_No_Flg + 1)
ElseIf RoundChange_Next_Flg = 0 Then
'前の項目群の場合
RoundChange_No_Flg = If(RoundChange_No_Flg > link_Folder_Count.Length - 1 Or RoundChange_No_Flg <= 0,
link_Folder_Count.Length - 1, RoundChange_No_Flg - 1)
End If
err_flg = 504
'今回の取得フォルダを得る
Dim link_Folder_Path As String = link_Folder_Count(RoundChange_No_Flg)
err_flg = 505
'指定フォルダ内のファイルリストを得る
Call Get_Folder_Items(link_Folder_Path)
err_flg = 506
Reset_Flg = True
GoTo Reset_Line 'やり直しさせる
ElseIf RoundChange_Reverse_Flg AndAlso RoundChange_location >= 1 AndAlso pos = -180 Then
'元の幅まで広がったときで、元の位置に戻った場合
Label1.Text = info_name(0).ToString() '項目名を取得する。
stop_flg = True '停止の指示を与える
End If
err_flg = 507
'■楕円の場合
'まずは、原点からのx位置を格納
Dim x As Integer = 0
err_flg = 510
'補正位置を返す
x += CInt((End_pos_Left \ 2) * ((Math.Sin((theta) * (Math.PI / 180)) * RoundChange_location) + 2))
g.DrawImage(CType(pic_obj(i), Bitmap), x,
convert_round_y_location(x_location, y_location, theta))
Next i
'枠の描画
g.DrawImage(imgWakuLT, End_pos_Left - imgWakuLT.Width + imgWaku_pos12,
End_pos_Top - imgWaku_pos16)
g.DrawImage(imgWakuRT, End_pos_Left - imgWakuLT.Width + imgWaku_pos16 + PictureBox1.Width,
End_pos_Top - imgWaku_pos16)
g.DrawImage(imgWakuLB, End_pos_Left - imgWakuLT.Width + imgWaku_pos12,
End_pos_Top - imgWaku_pos8 + PictureBox1.Height)
g.DrawImage(imgWakuRB, End_pos_Left - imgWakuLT.Width + imgWaku_pos16 + PictureBox1.Width,
End_pos_Top - imgWaku_pos8 + PictureBox1.Height)
End With
'■停止指示のある場合
If stop_flg Then
'規定まで達した場合
'まず、タイマーの解放
RoundChange_Timer.Enabled = False
RoundChange_Timer.Dispose()
RoundChange_Timer = Nothing
Label1.Visible = True
If Label2_Visible_Flg Then Label2.Visible = True
Label3.Visible = True
Normal_Flg = True '平常時を開始する。
If picMain IsNot Nothing AndAlso (Not picMain.IsDisposed) _
AndAlso open_Flg < 5 Then '安全装置(且つ、終了信号が出ていない場合)
picMain.Invalidate() '再描画させる。
End If
End If
Catch ex As Exception
'■エラー時
'終了要請タイマーを呼び出して、遅延させて終了処理処理させる。
MessageBox.Show(err_flg.ToString & " : " & ex.Message, "Err", MessageBoxButtons.OK, MessageBoxIcon.Error)
Call bf_End_Timer_Start()
Exit Sub
End Try
RoundChange_Timer_Tick_Flg = False
End Sub
Public Sub Do_RoundChange_Timer()
'回転交換用タイマー動作呼び出し用
'通常表示を停止する。
If Normal_Timer IsNot Nothing Then
Normal_Timer.Enabled = False
Normal_Timer.Dispose()
Normal_Timer = Nothing
End If
Normal_Flg = False '通常字の終了宣言
'動作値の初期化
pos = -180
RoundChange_Reverse_Flg = False
Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
If Not No_SoundEffect_Flg Then '効果音を鳴らす場合
'別スレッドで音を鳴らす
Call Sound_Play_Thread("change")
End If
'タイマーを呼び出して、 動作処理させる。
RoundChange_Timer = New Timer() 'タイマーオブジェクトの設定
AddHandler RoundChange_Timer.Tick, New EventHandler(AddressOf Do_Image_Timer_Tick_Sub) 'イベントを指定
RoundChange_Timer.Interval = Timer_Interval '動作間隔
RoundChange_Timer.Enabled = True '実行開始
Application.DoEvents()
Do '終了まで待機
Application.DoEvents()
Threading.Thread.Sleep(Timer_Interval)
Loop Until RoundChange_Timer Is Nothing
End Sub
Public Sub Do_Image_Timer_Tick_Sub()
Try
If picMain IsNot Nothing AndAlso open_Flg < 6 Then
'解放前で、終了処理がされていない場合
If Not picMain.IsDisposed Then
'再描画させる。
picMain.Invalidate()
End If
End If
Catch ex As Exception
End Try
End Sub
'選択枠の位置補正用
Public imgWaku_pos16 As Integer = 16
Public imgWaku_pos12 As Integer = 12
Public imgWaku_pos8 As Integer = 8
Public Sub picMain_Start_End_Paint(ByRef g As Graphics)
'■動作開始&終了時の描画
Dim err_flg As Integer = 0
Try
'動作中の場合→出る
If Image_Timer_Tick_Flg Then Exit Sub
'安全装置
If picMain Is Nothing Then Exit Sub
If picMain.IsDisposed Then Exit Sub
If g Is Nothing Then Exit Sub
'移動量の安全装置
If Open_move_span < 1 OrElse Open_move_span > 10 Then
Open_move_span = 5
End If
'動作中フラグを上げる
Image_Timer_Tick_Flg = True
With frmMain
'安全装置
If .IsDisposed OrElse (pic_obj Is Nothing) Then GoTo Exit_line
err_flg = 1
'螺旋運動をさせる。
'http://www.enjoy.ne.jp/~k-ichikawa/Fibonacci4.html
'http://msdn.microsoft.com/ja-jp/library/system.math.sin(v=vs.95).aspx
If Set_Out_Flg Then
'開く場合
pos = pos - Open_move_span
If pos < 0 Then pos = 0
Else '閉じる場合
pos = pos + Open_move_span
If pos > max_pos Then pos = max_pos
End If
err_flg = 2
'仮想x,y座標を、格納
x_location = CInt(Math.Cos(pos * (Math.PI / 180)) * 12 * pos)
y_location = CInt(Math.Sin(pos * (Math.PI / 180)) * 7 * pos)
err_flg = 3
For i As Integer = pic_obj.Count - 1 To 0 Step -1 '◆末尾から描く
'安全装置
If pic_obj(i) Is Nothing Then Exit Sub
Dim theta As Integer = CInt(Math.Round(round_theta / pic_obj.Count) * i)
g.DrawImage(CType(pic_obj(i), Bitmap), convert_round_x_location(x_location, y_location, theta),
convert_round_y_location(x_location, y_location, theta))
Next
err_flg = 4
g.DrawImage(imgWakuLT, End_pos_Left - imgWakuLT.Width + imgWaku_pos12 + (pos * 10),
End_pos_Top - imgWaku_pos16 + (pos * 10))
g.DrawImage(imgWakuRT, End_pos_Left - imgWakuLT.Width + imgWaku_pos16 - (pos * 10) + PictureBox1.Width,
End_pos_Top - imgWaku_pos16 + (pos * 10))
g.DrawImage(imgWakuLB, End_pos_Left - imgWakuLT.Width + imgWaku_pos12 + (pos * 10),
End_pos_Top - imgWaku_pos8 - (pos * 10) + PictureBox1.Height)
g.DrawImage(imgWakuRB, End_pos_Left - imgWakuLT.Width + imgWaku_pos16 - (pos * 10) + PictureBox1.Width,
End_pos_Top - imgWaku_pos8 - (pos * 10) + PictureBox1.Height)
err_flg = 5
If (pos <= 0 And Set_Out_Flg) OrElse
(pos >= max_pos And (Not Set_Out_Flg)) Then
'規定の値に達した場合
Exit_line:
'立ち上げ完了時
'まず、タイマーの解放
If Image_Timer IsNot Nothing Then
Image_Timer.Enabled = False
Image_Timer.Dispose()
End If
Image_Timer = Nothing
'■ロード時かどうか
If Set_Out_Flg Then
'ロード時のみだけ
'ラベルを表示する。
Label1.Text = info_name(0).ToString()
Label1.Visible = True
If Label2_Visible_Flg Then Label2.Visible = True
Label3.Visible = True
'※ここで、Windowsキーの終了用途待機フラグを上げる
open_Flg = 2
'ノーマルサイズになっていない場合
If frmMain.WindowState <> FormWindowState.Normal Then
frmMain.WindowState = FormWindowState.Normal 'ノーマルサイズにする。
End If
frmMain.BringToFront()
frmMain.Activate()
If Normal_Timer Is Nothing AndAlso Set_Out_Flg Then
'開く場合のみ、平常時描画を開始する。
Normal_Flg = True '通常描画・開始フラグ
picMain.Invalidate() '再描画する。
End If
End If
End If
End With
Catch ex As Exception
'■エラー時
'終了要請タイマーを呼び出して、遅延させて終了処理処理させる。
MessageBox.Show(err_flg.ToString & " : " & ex.Message, "Err", MessageBoxButtons.OK, MessageBoxIcon.Error)
Call bf_End_Timer_Start()
Exit Sub
End Try
Image_Timer_Tick_Flg = False
End Sub
'回転用タイマー。
Public Round_Timer As Timer
Public Round_Timer_Tick_Flg As Boolean = False
Public Left_Turn_Flg As Boolean = False '右回りかどうか
Public Sub picMain_Round_Paint(ByRef g As Graphics)
'■回転を描画する。
Dim err_flg = 400
Try
'安全装置
If Image_Timer IsNot Nothing OrElse
Round_Timer_Tick_Flg Then Exit Sub
'安全装置2
If picMain Is Nothing Then Exit Sub
If picMain.IsDisposed Then Exit Sub
If pic_obj Is Nothing Then Exit Sub
If g Is Nothing Then Exit Sub
'終了処理以降の場合→出る
If open_Flg >= 5 Then Exit Sub
'動作中フラグを上げる
Round_Timer_Tick_Flg = True
'回転限界を算出
Dim stop_flg As Boolean = False
'動作間隔を格納
Dim move_span As Integer = Round_move_span '180の約数でないといけない
With frmMain
If Not Normal_Flg Then
'■通常時でない場合→つまり、普通に回転させる場合→pos値を増減させて回転させる
If Left_Turn_Flg Then '左回りの場合
pos = If(pos <= -360, 0, pos - move_span)
Else '右回りの場合
pos = If(pos >= 0, -360, pos + move_span)
End If
End If
'終点に来た場合の再描画用フラグ
Dim Reset_Flg As Boolean = False '初期化
Reset_Line:
'各オブジェクトをループ
For i As Integer = pic_obj.Count - 1 To 0 Step -1 '◆末尾から描く
'安全装置
If pic_obj(i) Is Nothing Then Exit Sub
'四捨五入する。
'http://dobon.net/vb/dotnet/programing/round.html
Dim theta As Integer = CInt(Math.Round(round_theta / pic_obj.Count) * i)
'最終的な角度を求める
theta = pos + theta - 180
'■最も至近の項目の状態を監視する。
If Normal_Flg Then
'△通常待機の描画時
stop_flg = True '即停止(※そもそも、動かさない)
ElseIf pic_obj.Count = 1 AndAlso pos = -180 Then
'△1項目だけの場合で、-180度に来た場合→停止
stop_flg = True
Else '△回転動作時で、複数項目がある場合
If Left_Turn_Flg Then
'◎左回りの場合
If theta <= -359 And i = 1 AndAlso (Not Reset_Flg) Then
'至近の項目が、180度に来た場合→停止
'至近の項目が、180度に来た場合→停止
pos = -180 '最後のつめるとき用
'先頭pictureboxオブジェクトの交換
pic_obj.Add(pic_obj(0))
pic_obj.RemoveAt(0)
'先頭情報も、同じく交換する。
info_name.Add(info_name(0))
info_name.RemoveAt(0)
info_path.Add(info_path(0))
info_path.RemoveAt(0)
Label1.Text = info_name(0).ToString()
'停止フラグを立てる
stop_flg = True
Reset_Flg = True
GoTo Reset_Line
End If
Else '◎右回りの場合
If theta >= 0 And i = pic_obj.Count - 1 AndAlso (Not Reset_Flg) Then
'至近の項目が、180度に来た場合→停止
pos = -180 '最後のつめるとき用
'先頭pictureboxオブジェクトの交換
pic_obj.Insert(0, pic_obj(pic_obj.Count - 1))
pic_obj.RemoveAt(pic_obj.Count - 1)
'先頭情報も、同じく交換する。
info_name.Insert(0, info_name(info_name.Count - 1))
info_name.RemoveAt(info_name.Count - 1)
info_path.Insert(0, info_path(info_path.Count - 1))
info_path.RemoveAt(info_path.Count - 1)
Label1.Text = info_name(0).ToString()
'停止フラグを立てる
stop_flg = True
Reset_Flg = True
GoTo Reset_Line
End If
End If
End If
'■楕円の場合
x_location = 0 'そのまま回す
y_location = 0
g.DrawImage(CType(pic_obj(i), Bitmap), convert_round_x_location(x_location, y_location, theta),
convert_round_y_location(x_location, y_location, theta))
Next i
'枠の描画
g.DrawImage(imgWakuLT, End_pos_Left - imgWakuLT.Width + imgWaku_pos12,
End_pos_Top - imgWaku_pos16)
g.DrawImage(imgWakuRT, End_pos_Left - imgWakuLT.Width + imgWaku_pos16 + PictureBox1.Width,
End_pos_Top - imgWaku_pos16)
g.DrawImage(imgWakuLB, End_pos_Left - imgWakuLT.Width + imgWaku_pos12,
End_pos_Top - imgWaku_pos8 + PictureBox1.Height)
g.DrawImage(imgWakuRB, End_pos_Left - imgWakuLT.Width + imgWaku_pos16 + PictureBox1.Width,
End_pos_Top - imgWaku_pos8 + PictureBox1.Height)
End With
'■停止指示のある場合
If stop_flg Then
'規定まで達した場合
'まず、回転タイマーの解放
If Round_Timer IsNot Nothing Then
Round_Timer.Enabled = False
Round_Timer.Dispose()
End If
Round_Timer = Nothing
Normal_Flg = True '平常時を開始する。
If Normal_Timer Is Nothing AndAlso open_Flg < 5 Then
'平常時でない場合(且つ、終了信号が出ていない場合)
picMain.Invalidate() '→再描画する。
End If
End If
Catch ex As Exception
'■エラー時
'終了要請タイマーを呼び出して、遅延させて終了処理処理させる。
MessageBox.Show(err_flg.ToString & " : " & ex.Message, "Err", MessageBoxButtons.OK, MessageBoxIcon.Error)
Call bf_End_Timer_Start()
Exit Sub
End Try
Round_Timer_Tick_Flg = False
End Sub
Public Sub Do_Round_Timer()
'安全装置
If Round_Timer IsNot Nothing Then Exit Sub
'回転タイマー動作呼び出し用
'通常表示を停止する。
If Normal_Timer IsNot Nothing Then
Normal_Timer.Enabled = False
Normal_Timer.Dispose()
Normal_Timer = Nothing
End If
Normal_Flg = False
'動作値の初期化
pos = -180
If Not No_SoundEffect_Flg Then '効果音を鳴らす場合
'別スレッドで音を鳴らす
Call Sound_Play_Thread("turn")
End If
'タイマーを呼び出して、 動作処理させる。
Round_Timer = New Timer() 'タイマーオブジェクトの設定
AddHandler Round_Timer.Tick, New EventHandler(AddressOf Do_Image_Timer_Tick_Sub) 'イベントを指定
Round_Timer.Interval = Timer_Interval '動作間隔
Round_Timer.Enabled = True '実行開始
Application.DoEvents()
Do '終了まで待機
Application.DoEvents()
Threading.Thread.Sleep(Timer_Interval)
Loop Until Round_Timer Is Nothing
End Sub
Public Function convert_round_x_location(ByVal x_old As Integer, ByVal y_old As Integer, ByVal theta As Integer) As Integer
'指定した回転位置のx座標を、取得する。
'http://www.geisya.or.jp/~mwm48961/kou2/linear_image3.html
Dim i As Integer
'まずは、原点からのx位置を格納
i = CInt((x_old * Math.Cos(theta * (Math.PI / 180))) -
(y_old * Math.Sin(theta * (Math.PI / 180))))
'横補正位置を返す
i += CInt((End_pos_Left \ 2) * (Math.Sin((theta) * (Math.PI / 180)) + 2))
Return i
End Function
Public Function convert_round_y_location(ByVal x_old As Integer, ByVal y_old As Integer, ByVal theta As Integer) As Integer
'指定した回転位置のy座標を、取得する。
'http://www.geisya.or.jp/~mwm48961/kou2/linear_image3.html
Dim i As Integer
'まずは、原点からのy位置を格納
i = CInt((x_old * Math.Sin(theta * (Math.PI / 180))) +
(y_old * Math.Cos(theta * (Math.PI / 180))))
'縦補正位置を返す
i += CInt((End_pos_Top * (Math.Sin((theta - 90) * (Math.PI / 180)) + 2)))
Return i
End Function
Public Function scale_down_Image(ByVal orig As Bitmap) As Bitmap
'画像を縮小して返す
'orig=縮小する元となる画像の取得
Try
'安全装置(終了時には入らない)
If frmMain Is Nothing OrElse open_Flg >= 5 OrElse
PictureBox1 Is Nothing OrElse PictureBox1.IsDisposed Then
Return Nothing
End If
'元画像から、アスペクト比が同じのサムネイル画像の作成
Dim width As Integer, height As Integer '幅／高さ
If orig.Width >= orig.Height Then
'横長の画像の場合
width = PictureBox1.Width
height = (width * orig.Height) \ orig.Width
Else '縦長の画像の場合
height = PictureBox1.Height
width = (height * orig.Width) \ orig.Height
End If
'アスペクト比を維持した、サムネイル画像の作成◇高品質版
Dim ThumbnailImage As Bitmap = New Bitmap(width, height)
Using ImageGraph As Graphics = Graphics.FromImage(ThumbnailImage)
ImageGraph.SmoothingMode = Drawing2D.SmoothingMode.HighQuality '高画質に処理
ImageGraph.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality '高画質に処理
ImageGraph.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic '高画質に縮小
'指定したサイズに、拡大＆縮小した画像を取得する。
ImageGraph.DrawImage(orig, 0, 0, ThumbnailImage.Width, ThumbnailImage.Height)
If ImageGraph IsNot Nothing Then ImageGraph.Dispose()
End Using
'↑上で作ったサムネイル画像を、下地の画像に上乗せさせる。
Dim BackGroundImage As Bitmap = New Bitmap(BackGroundImage_bmp, PictureBox1.Width, PictureBox1.Height)
'乗せる位置を設定
Dim left As Integer = (BackGroundImage.Width - width) \ 2 '横位置は、中央に配置
Dim top As Integer = (BackGroundImage.Height - height) \ 2 '縦位置も、中央に接する
Using grh_background As Graphics = Graphics.FromImage(BackGroundImage)
grh_background.DrawImage(ThumbnailImage, left, top, ThumbnailImage.Width, ThumbnailImage.Height) '描画する。
'開放
orig.Dispose()
ThumbnailImage.Dispose()
grh_background.Dispose()
End Using
'下地に乗せて完成した画像を返す
Return BackGroundImage
Catch ex As Exception
Return orig
End Try
'エラー時
Return Nothing
End Function
'終了動作遅延用タイマー
Dim bf_End_Timer As Timer
Public Sub Application_Before_Close(open_Path As String)
'ソフトを閉じる準備を行う
'→うまく終了処理ができないため。直接frm背景を閉じるのではなく、
' 終了信号を、frm背景に送って、そこで、終了処理させている
'安全装置
If Image_Timer IsNot Nothing Then Exit Sub
If Round_Timer IsNot Nothing Then Exit Sub
If RoundChange_Timer IsNot Nothing Then Exit Sub
'終了準備中の指示フラグ
open_Flg = 5
'通常表示を停止する。
If Normal_Timer IsNot Nothing Then
Normal_Timer.Enabled = False
Normal_Timer.Dispose()
Normal_Timer = Nothing
End If
Normal_Flg = False
'移動方向を、開放に設定
Set_Out_Flg = False
'動作値の初期化
pos = 0
'ラベルを隠す
Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
If Not No_SoundEffect_Flg Then '効果音を鳴らす場合
'別スレッドで音を鳴らす
Call Sound_Play_Thread("close")
End If
'タイマーを呼び出して、 動作処理させる。
Image_Timer = New Timer() 'タイマーオブジェクトの設定
AddHandler Image_Timer.Tick, New EventHandler(AddressOf Do_Image_Timer_Tick_Sub) 'イベントを指定
Image_Timer.Interval = Timer_Interval '動作間隔
Image_Timer.Enabled = True '実行開始
Application.DoEvents()
'タイムアウト測定
Dim sw As New System.Diagnostics.Stopwatch()
sw.Start()
'最後に扱った項目を記憶する。→次回起動時はこの項目が選択されているようにする。
Last_List_Index = info_name(0).ToString()
Do '終了orタイムアウトまで待機
Application.DoEvents()
Threading.Thread.Sleep(Timer_Interval)
Loop Until (Image_Timer Is Nothing) OrElse
(sw.ElapsedMilliseconds >= TimeOut_mSec)
'まず、タイマーの解放
If Image_Timer IsNot Nothing Then
Image_Timer.Enabled = False
Image_Timer.Dispose()
End If
Image_Timer = Nothing
'測定の停止
sw.Stop() : sw = Nothing
'何か指定された場合
If open_Path <> "" Then
Try '指定ファイルを開く
If (open_Path.StartsWith("http")) Then
'URLはそのまま開く
Process.Start(open_Path)
ElseIf IO.File.Exists(open_Path) Then
'存在するファイルを開く
Process.Start(open_Path)
End If
Catch ex As Exception
End Try
End If
'終了要請タイマーを呼び出して、遅延させて終了処理処理させる。
Call bf_End_Timer_Start()
End Sub
Public Sub bf_End_Timer_Start()
'終了要請タイマーを呼び出して、遅延させて終了処理処理させる。
'終了タイマーの動作間隔を指定
Dim bf_End_Timer_Interval As Integer = Timer_Interval
bf_End_Timer = New Timer() 'タイマーオブジェクトの設定
AddHandler bf_End_Timer.Tick, New EventHandler(AddressOf bf_End_Timer_Tick) 'イベントを指定
bf_End_Timer.Interval = bf_End_Timer_Interval '動作間隔
bf_End_Timer.Enabled = True '実行開始
End Sub
Private Sub bf_End_Timer_Tick()
'■終了フラグ遅延用Timer
'まず、タイマーの解放
If bf_End_Timer IsNot Nothing Then
bf_End_Timer.Enabled = False
bf_End_Timer.Dispose()
End If
bf_End_Timer = Nothing
frmMain.Visible = False '一旦隠す。
Form1.Visible = False '一旦隠す。
'正常に閉じる指令を与えるフラグ
open_Flg = 6
End Sub
Public Sub KeyDown_Check(ByVal send_keys As Keys)
'キー入力の監視
If Image_Timer IsNot Nothing Then Exit Sub
If Round_Timer IsNot Nothing Then Exit Sub
If RoundChange_Timer IsNot Nothing Then Exit Sub
'終了準備中の以降のフラグの場合
If open_Flg >= 5 Then Exit Sub
'■以下、各入力の確認
If send_keys = Keys.Escape Then
'ESCキー
'ソフトを閉じる準備を行う
Call Application_Before_Close("") '正常時は、閉じる
ElseIf send_keys = Keys.Right AndAlso Round_Timer Is Nothing Then
'→ボタン / 右回転
Left_Turn_Flg = CBool(Left_Right_Key_Flg = 1) '回転報告の確認(意味が反転していないかどうか)
Call Do_Round_Timer()
ElseIf send_keys = Keys.Left AndAlso Round_Timer Is Nothing Then
'←ボタン / 左回転
Left_Turn_Flg = CBool(Not (Left_Right_Key_Flg = 1)) '回転報告の確認(意味が反転していないかどうか)
Call Do_Round_Timer()
ElseIf send_keys = Keys.Return OrElse send_keys = Keys.Enter Then
'Enterキーの場合
'ソフトを閉じる準備を行う
Call Application_Before_Close(info_path(0).ToString()) '開くファイルを指定して、閉じる
ElseIf (send_keys = Keys.Up OrElse send_keys = Keys.Down) AndAlso RoundChange_Timer Is Nothing Then
'↑↓ボタン
RoundChange_Next_Flg = If(send_keys = Keys.Up, CByte(1), CByte(0)) '↑なら1 / ↓なら0
'項目群の交換
Call Do_RoundChange_Timer()
End If
End Sub
Public Sub Get_Folder_Items(ByVal link_Folder_Path As String)
'指定フォルダ内のファイルリストを得る
Dim ary As New ArrayList
ary.AddRange(System.IO.Directory.GetFiles(
link_Folder_Path, "*", System.IO.SearchOption.TopDirectoryOnly))
ary.AddRange(System.IO.Directory.GetDirectories(
link_Folder_Path, "*", System.IO.SearchOption.TopDirectoryOnly))
'ファイルリストを渡す
Call Get_Link_FileInfo_Sub(DirectCast(ary.ToArray(GetType(String)), String()))
ary.Clear() : ary = Nothing
End Sub
Public Sub Delete_Folder_Link_Item()
Try '先頭リンクファイルを削除する。
If IO.File.Exists(info_path(0).ToString()) Then 'ファイルの存在の確認
IO.File.Delete(info_path(0).ToString()) 'リンクファイルの削除
'各・0項目の削除
pic_obj.RemoveAt(0)
info_name.RemoveAt(0)
info_path.RemoveAt(0)
End If
Catch ex As Exception
End Try
End Sub
'別スレッドで、音が鳴っているかどうか
Dim Do_sound_playing_Thread_Flg As Boolean = False
Public Sub Sound_Play_Thread(ByVal Sound_Name As String)
Try '別スレッドで、音を鳴らす
'Do_sound_playing_Thread_Subメソッドを別のスレッドで実行する
'効果音を鳴さない場合→出る
If No_SoundEffect_Flg Then Exit Sub
'別スレッドで、音が鳴っている場合→出る
If Do_sound_playing_Thread_Flg Then Exit Sub
'■引数を付けて、バックグラウンド再生する
'http://www.lasical.com/2011/02/22/1227/
Dim t As System.Threading.Thread
t = New System.Threading.Thread(New System.Threading.ParameterizedThreadStart(AddressOf Do_sound_playing_Thread_Sub))
'バックグランド処理に指定する。（Falseなら、フォアグランド処理）
t.IsBackground = True
'スレッドを開始する
t.Start(Sound_Name)
'タイムアウト測定
Dim sw As New System.Diagnostics.Stopwatch()
sw.Start()
Do '鳴動停止orタイムアウトまでループ
If open_Flg >= 6 Then
'終了準備中以降の指示フラグが出ている場合
Exit Do '出る
ElseIf Not t.IsAlive Then
'鳴動処理が終わった場合
Exit Do '出る
End If
Application.DoEvents()
Loop While (sw.ElapsedMilliseconds < TimeOut_mSec) '最悪タイムアウトまで待機
'タイムアウト測定の停止
sw.Stop() : sw = Nothing
If t.IsAlive Then 'タイムアウトした場合
t.Abort() '中止
End If
'解放
If t IsNot Nothing Then t = Nothing
Catch ex As Exception
End Try
End Sub
Public Sub Do_sound_playing_Thread_Sub(ByVal Sound_Name As String)
'動作フラグを立てる
Do_sound_playing_Thread_Flg = True
Try '引数を確認
Sound_Name = Sound_Name.ToLower '小文字に統一
'再生されているときは止める
If Not (wav_player Is Nothing) Then wav_StopSound()
'ネット空間からの音を再生します。
Select Case Sound_Name
Case "turn"
wav_player = New System.Media.SoundPlayer(wav_st(0))
Case "close"
wav_player = New System.Media.SoundPlayer(wav_st(1))
Case "open"
wav_player = New System.Media.SoundPlayer(wav_st(2))
Case "change"
wav_player = New System.Media.SoundPlayer(wav_st(3))
End Select
'非同期再生する
wav_player.Play()
Catch ex As Exception
End Try
'動作フラグを下げる
Do_sound_playing_Thread_Flg = False
End Sub
'再生されている音を止める
Public Sub wav_StopSound()
If Not (wav_player Is Nothing) Then
wav_player.Stop()
wav_player.Dispose()
wav_player = Nothing
End If
End Sub
End Module
サンプル
上記コードのサンプルexeは、こちらのリンクに置いてあります。
おわりに
難解で長いコードとなってしまったことをお許しください。
ここまでご覧いただきありがとうございます。
尚、
コード中のURLは参考にさせていただいたサイト様のものでございます
この場にて厚く御礼申し上げます。
そして、このメニューソフトを作るきっかけとなった
聖剣伝説2、3のメニューを考案された方には大変敬服しております。
ありがとうございました。