インターネット上の画像をファイルとして保存せずにピクチャーボックスに表示するには?

解決


くす  2004-12-07 10:32:21  No: 118046  IP: [192.*.*.*]

WindowsXP VisualBasic 6.0 にてプログラミングしています。
Inetコントロールにてインターネット上からGIF画像を一定間隔でダウンロードしてピクチャーボックスに表示しています。

' 変数の宣言
Dim DataArea() As Byte    
' 画像のダウンロード
DataArea = Inet1.OpenURL("http://www.xxx.com/aaa.gif", icByteArray)
' 保存
Open "d:\aaa.gif" For Binary Access Write As #1
Put #1, , DataArea()
Close #1
' 表示
Picture1.Picture = LoadPicture(FileName)

このようなコードの、「保存」の部分を経由しないで表示を行いたいのですが、可能でしょうか?

よろしくお願いいたします。

編集 削除
nanashi  2004-12-07 11:34:54  No: 118047  IP: [192.*.*.*]

OleLoadPicturePathとか。
こんなん↓


Option Explicit

Private Type TGUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Declare Function OleLoadPicturePath Lib _
    "oleaut32.dll" _
    (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, _
     ByVal clrReserved As OLE_COLOR, ByRef riid As TGUID, ByRef ppvRet As IPicture) _
        As Long

Private Function LoadURLPicture(ByVal sURL As String) As Picture
    Dim IID  As TGUID
    
    'TGUIDの設定
    With IID
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    
    On Error GoTo ERR_LINE
    
    Call OleLoadPicturePath(StrPtr(sURL), 0&, 0&, 0&, IID, LoadURLPicture)
    
    Exit Function
    
ERR_LINE:
    
    On Error Resume Next
    
    Set LoadURLPicture = LoadPicture(sURL)
    
    On Error GoTo 0
End Function

Private Sub Command1_Click()
    
    Set Picture1.Picture = LoadURLPicture("http://www.google.co.jp/intl/ja_jp/images/logo.gif")
End Sub

編集 削除
くす  2004-12-07 12:12:03  No: 118048  IP: [192.*.*.*]

返信ありがとうございます。上記のものを実行すると、
Declare Functionの部分で「ユーザー定義型は定義されていません。」というエラーが出てしまいます。
初心者で申し訳ありませんがご教授ください。
よろしくお願いいたします。

また、上記の方法は私には難しすぎて何をやっているかわかりません。
もっと簡単な方法がもしあればそれも教えていただければ幸いです。

お願いいたします。

編集 削除
魔界の仮面弁士  2004-12-07 12:12:41  No: 118049  IP: [192.*.*.*]

UserControlを貼り付けて、AsyncReadメソッドを使う方法も。


--- UserControl1 ---
Option Explicit

Public Sub LoadPicture(ByVal URL As String)
    Dim Flag As AsyncReadConstants
    Flag = vbAsyncReadGetFromCacheIfNetFail
    UserControl.AsyncRead URL, vbAsyncTypePicture, "Picture", Flag
End Sub

Private Sub UserControl_Initialize()
    AutoRedraw = True
End Sub
Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
    On Error Resume Next
    Set Picture = AsyncProp.Value
    If Err.Number <> 0 Then
        Cls
        Print Err.Description
    End If
End Sub
Private Sub UserControl_AsyncReadProgress(AsyncProp As AsyncProperty)
    Cls
    Print "読み込み中: "; AsyncProp.BytesRead; "/"; AsyncProp.BytesMax
End Sub


--- Form1 (上記のコントロールと、コマンドボタンを貼っておく) ---
Option Explicit
Private Sub Command1_Click()
    UserControl11.LoadPicture "http://alucard-k.hp.infoseek.co.jp/lovedog/132nasubi.jpg"
End Sub

編集 削除
nanashi  2004-12-07 12:28:26  No: 118050  IP: [192.*.*.*]

> 上記のものを実行すると、Declare Functionの部分で
> 「ユーザー定義型は定義されていません。」というエラーが出てしまいます。

ちゃんと全部コピペしてる?(TGUIDのとことか)
私のところではエラー出ませんけど…。

> また、上記の方法は私には難しすぎて何をやっているかわかりません。

APIを使ってるんですけど、詳しいことは私も分かりません(^^;
以前どこかの掲示板で見かけて、使えそうなので関数作ってとっておいたものなので。

編集 削除
くす  2004-12-07 18:51:09  No: 118051  IP: [192.*.*.*]

nanashiさん、魔界の仮面弁士さん、
返信どうもありがとうございます。

魔界の仮面弁士さんの方法はもっとわかりませんでした。
すみません・・・。

nanashiさんのほうを新規プロジェクトを作って張ってみたらうまくいきました。
今作っているものにマージしようとして失敗したようです。

どうもありがとうございました。

編集 削除
くす  2004-12-08 16:58:59  No: 118052  IP: [192.*.*.*]

自己レスです。

参照設定で「OLE Automation」にチェックを入れておかないと、
nanashiさんの方法でエラーが出るようです。
チェックを入れることで現在のプログラムとのマージに成功しました。

編集 削除