フォームには、オートスクロール対応のパネル(PN1)の上に、画像表示用のピクチャボックス(PIC1)、さらに、メニュー用のツールバー(TB1)、情報表示用のステータスバー(SB1)を上下に配置します。
|
- フォームと配置したコントロール - ・SlideShow（フォーム） ... Text : スライドショー ・TB1（ツールバー） ... ImageList : IL1 / SHowToolTips : True ・SB1（ステータスバー） ... ShowPanels : True ・PN1（パネル） ... AutoScroll : Auto / Dock : Fill / BackColor : 64,64,64 / BorderStyle : Fixed3D ・PIC1（ピクチャボックス） ・IL1（イメージリスト） ... ImageSize : 24,24 / ColorDepth : Depth24Bit ・TIM1（タイマー） ・PUP1（コンテキストメニュー） | |
|
- ツールバーボタン - （）はImageIndex ①マニュアル・スライド操作部 ... tbHead : 先頭へ移動 (0) ... tbPrev : 先頭へ移動 (1) ... tbNext : 先頭へ移動 (2) ... tbTail : 末尾へ移動 (3) ②フィットモード操作部 ... tbFit : フィットモード (4) ③オート・スライド操作部 ... tbRev : オートスライド（逆方向） (5) ... tbStop : オートスライドの停止 (6) ... tbPlay : オートスライド（正方向） (7) ... tbInterval : スライド間隔 (8) |
- メニューアイテム - ④スライド間隔の設定 ... mnLong : 長い(&L) ... mnNormal : 標準(&N) ... mnShort : 短い(&S) - ステータスバーパネル - ⑤ファイル情報の表示 ... sbInfo : AutoSize=Spring （ファイル名表示用） ... sbPos : AutoSize=None （ファイル位置表示用） |
- コンストラクタでフォルダ名を受け取り、→ New （コンストラクタのオーバーロード）
- イメージファイルの配列を取得し、→ GetImageFiles （ユーザー関数）
- フォーム読込時に、→ OnLoad （ロードイベント）
- 最初の画像を描画する → DrawImage （ユーザー関数）
SlideShow.vb（フォームデザイナのコードは省略しています）
' 内部変数
Private m_files As String() ' イメージファイルの配列
Private m_current As Integer = -1 ' 現在表示中のインデックス
' コンストラクタ（オーバーロード ... 引数：フォルダ名）
Public Sub New(ByVal path As String)
MyBase.New()
Me.InitializeComponent()
' イメージファイルの配列の取得
If IO.Directory.Exists(path) Then m_files = GetImageFiles(path)
End Sub
' イメージファイルの配列の取得
Public Function GetImageFiles(ByVal path As String) As String()
Dim aExt As String() = {".bmp", ".jpg", ".jpeg", ".png", ".gif", ".ico"} ' 拡張子
Dim aFile As String() = Nothing ' イメージファイルの配列
Dim strFile As String ' ファイル名
Dim nLen As Integer = -1 ' 配列長
' ファイルが指定の拡張子であれば配列に追加
For Each strFile In IO.Directory.GetFiles(path)
Dim strExt As String
For Each strExt In aExt
If StrComp(IO.Path.GetExtension(strFile), strExt, CompareMethod.Text) = 0 Then
nLen += 1
ReDim Preserve aFile(nLen)
aFile(nLen) = strFile
End If
Next
Next
Return aFile
End Function
' 描画（引数：インデックス、戻り値：描画結果）
Private Function DrawImage(ByVal index As Integer) As Boolean
' インデックスが範囲外の時
If index < 0 OrElse index >= m_files.Length Then Return False
' カレントインデックスを更新
m_current = index
' ファイルが見つからない時
If IO.File.Exists(m_files(index)) = False Then
If Not IsNothing(PIC1.Image) Then PIC1.Image.Dispose()
MessageBox.Show("ファイル" & m_files(index) & "が見つかりませんでした。", _
"エラー", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return False
End If
Cursor.Current = Cursors.WaitCursor
PIC1.Visible = False
' 描画領域の取得
Dim r As Rectangle ' 描画領域
Dim m As Image = Bitmap.FromFile(m_files(index)) ' 元画像
r = New Rectangle(0, 0, m.Width, m.Height)
' ピクチャボックスの設定
If Not IsNothing(PIC1.Image) Then PIC1.Image.Dispose() ' 既存のイメージを破棄
PIC1.Image = New Bitmap(r.Width, r.Height) ' イメージをセット
PIC1.Location = PN1.AutoScrollPosition ' 位置
PIC1.Size = r.Size ' サイズ
' グラフィックオブジェクトで描画
Dim g As Graphics = Graphics.FromImage(PIC1.Image)
g.InterpolationMode = Drawing.Drawing2D.InterpolationMode.HighQualityBicubic
g.DrawImage(m, r)
' リソースの解放
g.Dispose()
m.Dispose()
' ステータスバーを更新
sbInfo.Text = m_files(index)
sbPos.Text = index + 1 & " / " & m_files.Length
Cursor.Current = Cursors.Default
PIC1.Visible = True
Return True
End Function
' フォームのロード
Protected Overrides Sub OnLoad(ByVal e As EventArgs)
TIM1.Enabled = False ' タイマーをオフにしておく
DrawImage(0) ' 最初のイメージを表示
End Sub
以下はメインフォーム側のコーディング例です。上記のコードにツールバーメニューのコード（本ページ末尾に掲載）を加えれば、マニュアル部分の操作は可能となります。
| MainForm.vb
' メニュー ... スライドショー
Private Sub mnSlide_Click(ByVal sender As Object, _
ByVal e As EventArgs) Handles mnSlide.Click
If Not IsNothing(m_path) AndAlso m_path <> "" Then
Dim f As New SlideShow(m_path)
f.Show()
End If
End Sub |
' 内部変数
Private m_fit As Boolean = False ' フィットモード
' 描画（引数：インデックス、戻り値：描画結果）
Private Function DrawImage(ByVal index As Integer) As Boolean
...
...
' 描画領域の取得
Dim r As Rectangle ' 描画領域
Dim m As Image = Bitmap.FromFile(m_files(index)) ' 元画像
If m_fit Then
' フィットモードがオンの時
Dim ratio As Double ' 拡大/縮小の比率
If (PN1.ClientSize.Width / m.Width) < (PN1.ClientSize.Height / m.Height) Then
ratio = PN1.ClientSize.Width / m.Width
Else
ratio = PN1.ClientSize.Height / m.Height
End If
r = New Rectangle(0, 0, CInt(m.Width * ratio), CInt(m.Height * ratio))
Else
' フィットモードがオフの時
r = New Rectangle(0, 0, m.Width, m.Height)
End If
...
...
End Function
' フィットモードの切り替え
Private Sub ChangeFitMode()
m_fit = Not m_fit ' フラグを更新
tbFit.Pushed = m_fit ' ツールバーボタンの状態を更新
DrawImage(m_current) ' 再描画
End Sub
以下は、ユーザーがフォームサイズを変更した時に対応するコードです。これを加えると、フォームのサイズが変更するにつれて画像のサイズも変更されます。
' パネルのリサイズイベント
Private Sub PN1_Resize(ByVal sender As Object, ByVal e As EventArgs) Handles PN1.Resize
' フィットモード時はイメージのサイズを更新
If m_fit Then DrawImage(m_current)
End Sub
' 変数
Private m_direction As Boolean ' 進む方向 （True:正方向 / False:逆方向）
' 列挙体 : 画像を切り替える間隔（ミリ秒）
Private Enum TimeInterval
IntervalLong = 5000
IntervalNormal = 3000
IntervalShort = 1000
End Enum
' タイマー・イベント
Private Sub TIM1_Tick(ByVal sender As Object, ByVal e As EventArgs) Handles TIM1.Tick
Dim n As Integer = CInt(IIf(m_direction, 1, -1)) ' 進めるインデックス
If DrawImage(m_current + n) = False Then
TIM1.Enabled = False ' 描画関数を呼び出して False が返ってきたら停止
End If
End Sub
' オートスライドの開始 （引数： True=正方向/False=逆方向）
Private Sub StartAutoSlide(ByVal direction As Boolean)
TIM1.Enabled = False ' タイマー停止
m_direction = direction ' 方向設定
TIM1.Enabled = True ' タイマー再開
End Sub
スライド間隔の設定は、コンテキストメニュー (PUP1) で行います。コンテキストメニューはツールバーボタン (tbInterval) をクリックすると表示されるようにしています（TB1_ButtonClick を参照）。また、ロードイベントで、スライド間隔を初期化しています。
' 間隔メニューのクリック
Private Sub Interval_Click(ByVal sender As Object, ByVal e As EventArgs) _
Handles mnLong.Click, mnNormal.Click, mnShort.Click
Static CheckedItem As MenuItem = Nothing ' 現在のチェックメニュー
If Not IsNothing(CheckedItem) Then
CheckedItem.Checked = False ' チェックをはずす
End If
CheckedItem = DirectCast(sender, MenuItem)
CheckedItem.Checked = True ' チェックをつける
' タイマーに値を設定
If CheckedItem Is mnLong Then
TIM1.interval = TimeInterval.IntervalLong
ElseIf CheckedItem Is mnNormal Then
TIM1.interval = TimeInterval.IntervalNormal
ElseIf CheckedItem Is mnShort Then
TIM1,interval = TimeInterval.IntervalShort
End If
End Sub
' フォームのロード
Protected Overrides Sub OnLoad(ByVal e As EventArgs)
mnNormal.PerformClick() ' スライドの間隔の初期化
TIM1.Enabled = False ' タイマーをオフに
DrawImage(0) ' 最初のイメージを表示
End Sub
' ツールバーボタンのクリック
Private Sub TB1_ButtonClick(ByVal sender As Object, _
ByVal e As ToolBarButtonClickEventArgs) Handles TB1.ButtonClick
Dim b As Boolean = Not IsNothing(m_files) AndAlso m_files.Length > 0
If e.Button Is tbHead Then
If b Then DrawImage(0) ' 先頭へ移動
ElseIf e.Button Is tbPrev Then
If b Then DrawImage(m_current - 1) ' 前の画像
ElseIf e.Button Is tbNext Then
If b Then DrawImage(m_current + 1) ' 次の画像
ElseIf e.Button Is tbTail Then
If b Then DrawImage(m_files.Length - 1) ' 末尾へ移動
ElseIf e.Button Is tbFit Then
ChangeFitMode() ' フィットモードの切り替え
ElseIf e.Button Is tbRev Then
If b Then StartAutoSlide(False) ' オートスライドの開始（逆方向）
ElseIf e.Button Is tbStop Then
TIM1.Enabled = False ' オートスライドの停止
ElseIf e.Button Is tbPlay Then
If b Then StartAutoSlide(True) ' オートスライドの開始(正方向)
ElseIf e.Button Is tbInterval Then
' スライド間隔の変更（ポップアップメニューの表示）
PUP1.Show(TB1, New Point(tbInterval.Rectangle.X, tbInterval.Rectangle.Bottom))
End If
End Sub