アニメーションファイルを表示
 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。
GIFファイルのアニメーションをVBで表示　　　　　　　　　　　(208)
　　　 'プロジェクト→コンポーネント で　Microsoft Internet Controls に
'チェックを入れて、WebBrowserコントロールをFormに貼り付けて下さい
'プロジェクト→参照設定　で Microsoft HTML Object Library に
'チェックを入れておいて下さい。

Option Explicit　　 'SampleNo=208　WindowsXP VB6.0(SP5) 2002.09.14

'デバイスコンテキストの背景色を取得する(443)
Private Declare Function GetBkColor Lib "gdi32" _
　　(ByVal hdc As Long) As Long

Private MyURL　　　 As String
Private WorkNo　　　As Long

Private Sub WebBrowser1_DocumentComplete( _
　　　　　　　　　　　　　ByVal pDisp As Object, URL As Variant)
　 Dim HStyl　　　 As HTMLStyle
　 Dim myRGB　　　 As Variant
　 Dim BkColor　　 As String

　 If MyURL = URL And WorkNo = 1 Then
　　　Set HStyl = WebBrowser1.Document.body.Style
　　　'バックカラーの設定（フォームと同じ色に）
　　　If Me.BackColor <> vbButtonFace Then
　　　　　'フォームのバックカラーを取得し、HTM形式の色コードに変換
　　　　　myRGB = HtmColor(GetBkColor(Me.hdc))
　　　　　'コメントを外せば条件分けしなくてもＯＫ、その場合起動時の
　　　　　'フォームの色のままです。
　　　　　' Me.BackColor = GetBkColor(Me.hdc)
　　　　　BkColor = "#" & myRGB(0) & myRGB(1) & myRGB(2)
　　　Else
　　　　　'こちらは起動中システムカラーが変更されたらそれが有効になる
　　　　　BkColor = "ThreeDFace"
　　　End If
　　　With HStyl
　　　　　.backgroundColor = BkColor
　　　　　'枠線を非表示に設定(スペースを指定すると凹型になる"
　　　　　.border = "0"　　　 '.border = " "
　　　　　'スクロールバーを非表示に設定　 '.overflowX = "hidden"
　　　　　.overflow = "hidden"　　'他に visible・scroll・auto が設定可能
　　　　　'表示位置の設定
　　　　　'Top 及び Left マージンを設定（単位＝Pixel）
　　　　　.marginLeft = "10px"
　　　　　.marginTop = "10px"
　　　End With
　　　Set HStyl = Nothing
　 End If

　 If MyURL = URL And WorkNo = 2 Then
　　　MyURL = CreateObject("Scripting.FileSystemObject" _
　　　　　　　　　　　　　 ).GetAbsolutePathName("..\AN050.GIF")

　　　WebBrowser1.Document.write "<img src='" & MyURL & "'>"
　　　WebBrowser1.Document.write "<img src='" & MyURL & "'>"
　　　Set HStyl = WebBrowser1.Document.body.Style
　　　With HStyl
　　　　 .backgroundColor = "ThreeDFace"
　　　　 '枠線を非表示に設定(スペースを指定すると凹型になる"
　　　　 .border = "0"　　　 '.border = " "
　　　　 'スクロールバーを非表示に設定　 '.overflowX = "hidden"
　　　　 .overflow = "hidden"　　'他に visible・scroll・auto が設定可能
　　　　 '表示位置の設定
　　　　 'Top 及び Left マージンを設定（単位＝Pixel）
　　　　 .marginLeft = "10px"
　　　　 .marginTop = "10px"
　　　End With
　　　Set HStyl = Nothing
　 End If
End Sub

Private Sub Command1_Click()
'通常表示
　 MyURL = CreateObject("Scripting.FileSystemObject" _
　　　　　　　　　　　　　).GetAbsolutePathName("..\AN050.gif")
　 WebBrowser1.Navigate MyURL
　 WorkNo = 1
End Sub

Private Sub Command2_Click()
'複数表示１
　 MyURL = "about:blank"
　 WebBrowser1.Navigate2 MyURL
　 WorkNo = 2
End Sub


Private Function HtmColor(ByVal VBColor As Long) As Variant
'VBの色コードからHTMの色コードに変換
　　Dim R As String
　　Dim G As String
　　Dim B As String
　　R = Hex$(VBColor And vbRed)
　　G = Hex$((VBColor And vbGreen) \ &H100)
　　B = Hex$((VBColor And vbBlue) \ &H10000)
　　If Len(R) = 1 Then R = "0" & R
　　If Len(G) = 1 Then G = "0" & G
　　If Len(B) = 1 Then B = "0" & B
　　HtmColor = Array(R, G, B)
End Function

　
HTMとはカラーの設定値が違うのでバックカラーを取得して、HTM形式のカラー値に変換して
設定しています。バックカラーについては好みにより設定を変更して下さい。

WebBrowserコントロールのヘルプ[Webrowse.hlp]は「Office 97」のCD-ROMの中に
あります。「Office 97」をお持ちでしたら探して見て下さい。（但し、古いですが日本語版です）

以前のサンプルでは、WebBrowserコントロールのスクロールバーが表示したままなので、（WEB
上で見かける他のサンプルも同様）消す方法が無いものと思い裏業を使っていたのですが、V友
に［魔界の仮面弁士］さんの投稿があって非表示にできる事を知り、色々調べていたらヘルプ
ファイルの存在も知り、魔界の仮面弁士さんの投稿等を参考に今回サンプルを作り直しました。
事前バインディングする事で、インテリセンス機能が働き、簡単に設定を色々試す事ができる
かと思います。
その他、詳しくはプログラム専用掲示板のNo.２５８２〜とNo.２６１７〜の一連の投稿を見て下さい。
　　　　　　　　


2003/02/08
2009/12/30