画像とテキストを一つのファイルで保存
解決pictureオブジェクトの画像と、テキストを一つのファイルで保存する良い方法はありますか？
現在は、保存するさいに、
open FILENAME for output as #1 コマンドで、
テキストを書き込んだあとに、pictureオブジェクトのドット数分のカラーデータ（&HFF0088&等）を書き込んでいますが、ファイルサイズが膨大になります。
例えば、画像を圧縮してさらにテキストも同時に保存する方法など、
いい方法がありましたら教えてください。
あと、ファイルの種類（拡張子）も教えてください。
なるべく既成のOCXやDLLを使わない方法で教えてください。
よろしくお願いします。
Dim B() As Byte
With New PropertyBag
.WriteProperty "Picture", Image1.Picture
.WriteProperty "FileName", "サンプル画像"
B = .Contents
End With
って感じで、(VB6の)PropertyBag にパーシストして、
そのバイナリを保存するようにするとか。
読み込みはその逆。
With New PropertyBag
.Contents = B
Label1.Caption = .ReadProperty("FileName", "")
Set Image2.Picture = .ReadProperty("Picture", Nothing)
End With
言い忘れていてすみません。
うちの環境はVB5です。
教えていただいたことを試してみたら、
NEWキーワードの使用法が不正です。
と言うエラーが出ました。
せっかく教えていただいたのにすみません。
VB5で可能な方法はございますか？
上記が使えるのは、VB6 の PropertyBag の場合ですね。
VB5のPropertyBagや、VB6のPropertyBag_VB5だと無理です。
> VB5で可能な方法はございますか？
API や OCX 等も使わないと限定条件となると、Picture 型をバイナリに
変換する手段が、SavePicture に限られてしまいますね。
となると、たとえば画像を、SavePicture で一時ファイルに保存してから、
それをバイナリとして読み直し、そのバイナリを
Public Type hoge
Name As String
Binary() As Byte
End Type
なユーザー定義型に入れなおした後、改めて Put # してみるとか。
読み込み時は、このユーザー定義型に Get # した後で、
Binary 部分だけを一時ファイルに保存しなおし、それを LoadPicture。
ありがとうございます。
実はいつもINPUT、OUTPUTを使っているので、PUT、GETについて今調べています。
この部分は自分で調べてみますので、できたら（できなかったら）またお返事します。
くだらない質問かもしれませんが、hogeというのは、任意という意味ですか？それとも、hogeという定数があるのですか？本当に分からないので、教えてください。よろしくお願いします。
> 任意という意味ですか？それとも、hogeという定数があるのですか？
前者です。深い意味は特にありません。(^^;
hoge 以外には、moge とか hage とか hige とか foo とか bar とかも同様です。
# 下記には、「ファイル名や関数名、変数名などの命名」に使われるとありますね。
# http://kmaebashi.com/programmer/hoge.html
>> 既成のOCXやDLLを使わない方法で教えてください。
この前提からは外れますが、一応補足。
> Binary 部分だけを一時ファイルに保存しなおし、それを LoadPicture。
もしも API を使っても構わないのであれば、一時ファイルを使わず、
読み込んだバイナリを、直接 Picture オブジェクトに変換する事ができます。
http://yaplog.jp/orator/archive/19
逆に、Picture をバイナリへ保存する際には、IPersistStream.Save が使えます。
魔界の仮面弁士さん、いろいろアドバイスありがとうございます。
いろいろ試してみたのですが、うまくいってません。
質問のレベルを落としていいですか?
Picture をバイナリへ保存する際には、IPersistStream.Save が使えます。
とありますが、具体的にどうしたらよいのでしょうか？
また、ファイル形式（拡張子）は何になるのでしょうか？
ちなみに、うちが VB5 なので、それでうまくいってないのでしょうか？
よろしくお願いします。
IPersistStream は、『インターフェイス』です。
ただ、非.NET な VB には、インターフェイスを定義する機能が無いため、
それを定義したタイプライブラリを作成し、それを参照設定して
利用する事になります。それさえ出来てしまえば、あとは
Dim P As IPersistStream
Set P = (任意のPictureオブジェクト) 'Form1.Icont とか LoadPicture の結果とか
P.Save 保存先のストリーム, False
のようにして利用できます。
なお、タイプライブラリを自作される気があるなら、VB5のインストールCDの
Shelllnk フォルダに、ODL(オブジェクト定義言語)で書かれたタイプライブラリの
サンプルがありますので、それが参考になるでしょう。
# ただしそれには、IPersistStream の定義は載っていないので、
# odl ファイルを、自分で書きなおす必要があります。
> また、ファイル形式（拡張子）は何になるのでしょうか？
拡張子が変わっても、ファイルの中身が変わるわけでは無いので、
何を指定しても良いと思いますよ。自由に決めてください。
まぁ、画像をそのまま保存する場合(SavePicture や IPersistStream.Save などで)は、
Picture オブジェクトの内容によって決めてあげれば良いと思いますよ。
Picture オブジェクトの Type プロパティが vbPicTypeBitmap (=1)を
返すのであれば、いわゆるビットマップファイルなので bmp でしょうし、
vbPicTypeIcon (=3) だったなら、ico にしておくと良いかも知れませんね。
IPersistStreamにしなくても、IPicture.SaveAsFileメソッドで
同様のことはできます。念のため。
ありがとうございます。
実は分からないことがいっぱいあります。
・タイプライブラリ
・保存先のストリーム
・ODL(オブジェクト定義言語)
全く意味が分からないので、もう一度質問を変えていいですか。
aaa.bmp
bbb.txt
この2つのファイルを1つに合体し、それを呼び出し出す方法はありますか？
せっかく答えてくれているのにすみません。
方法と書くとあいまいなので、ずばり
aaa.bmp
bbb.txt
この2つのファイルを1つに合体し、
ccc.ccc
というファイルを作るコードはどう書いたらいいですか？
あと、それを呼び出して、
picture1.picture
text1.text
に値を代入するところまで。
質問が甘いですかね？
すみませんがよろしくお願いします。
これだけヒントもらっているのに、プログラム書いてくださいだと、、、
掲示板ってそういうところでしょうか？
作成依頼ならば、お金を払ってつくってもらってください。
(激高ですが。)
Windows DIB 形式のBitmapならば、ヘッダーを調べればファイルの
サイズがわかります。ですから、
保存時には、まずSavePictureで画像を保存し、そのファイルを開き
なおして、ファイルの末尾から文字列を書き込む。
読み込み時には、ヘッダーを調べて、どこまでが画像をあらわすデータ
=どこからが文字列をあらわすデータなのかを調べて、そこから文字列を
読み込み、その後でLoadPictureで画像を読み込む。
とするぐらいでも、とりあえずは用件を満たすことになるのでは。
ちなみに、ヘッダーに関しては、MSDNなどでBITMAPFILEHEADERや
BITMAPINFOHEADER構造体などについて調べてください。
ご迷惑をおかけしてすみません。
コードを教えてくださいというのは間違っていたと思います。
教えていただいたヒントを元に自分で考えてみます。
魔界の仮面弁士さんと、darkさんと、K.J.K.さん、
ありがとうございました。
手元に VB4 環境があったので、それで作成してみました。
おそらく VB5 でも動くと思います。参考になれば。
'==================================================
Option Explicit
Option Base 0
Private Const DataFileName As String = "C:\SAMPLE.DATA"
'--------------------------------------------------
Private Sub Command1_Click()
Set Image1.Picture = LoadPicture()
On Error Resume Next
Set Image1.Picture = Clipboard.GetData()
If Err.Number <> 0 Then
MsgBox Err.Description, vbInformation
End If
End Sub
'--------------------------------------------------
Private Sub Command2_Click()
On Error Resume Next
SaveToFile DataFileName, Image1.Picture, Text1.Text
If Err.Number = 0 Then
MsgBox "正常に保存されました。", vbInformation
Else
MsgBox Err.Description, vbInformation
End If
End Sub
'--------------------------------------------------
Private Sub Command3_Click()
Dim ImageText As Variant
Set Image2.Picture = LoadPicture()
Text2.Text = ""
On Error Resume Next
Set Image2.Picture = LoadFromFile(DataFileName, ImageText)
If Err.Number = 0 Then
Text2.Text = CStr(ImageText)
MsgBox "正常に読み込まれました。", vbInformation
Else
MsgBox Err.Description, vbInformation
End If
End Sub
'--------------------------------------------------
Private Sub Form_Load()
Command1.Caption = "クリップボードから画像の読み込み"
Command2.Caption = "ファイルへの保存"
Command3.Caption = "ファイルから読込"
Text1.Text = "任意の文字列"
Text2.Text = ""
Text2.Locked = True
Set Image1.Picture = LoadPicture()
Set Image2.Picture = LoadPicture()
End Sub
'--------------------------------------------------
Public Sub SaveToFile( _
ByVal FileName As String, _
ByVal Image As Picture, _
Optional Text As Variant)
Dim Binary() As Byte
Binary = ""
'Pictureオブジェクトを一時ファイルに保存
Dim WorkFileName As String
Dim ImageSize As Long
WorkFileName = FileName & ".~image"
If Image Is Nothing Then
Set Image = LoadPicture()
End If
If Image.Type <> 0 Then
SavePicture Image, WorkFileName
'一時ファイルからバイナリデータを読み込み
Dim WorkFileNo As Integer
WorkFileNo = FreeFile(1)
Open WorkFileName For Binary Access Read As #WorkFileNo
ImageSize = LOF(WorkFileNo)
ReDim Binary(ImageSize - 1)
Get #WorkFileNo, , Binary
Close #WorkFileNo
Kill WorkFileName
End If
'データファイルを開く
Dim FNo As Integer
FNo = FreeFile(0)
Open FileName For Output Access Write As #FNo
Close #FNo
Open FileName For Binary Access Write As #FNo
'ファイルの保存
Put #FNo, , ImageSize '先頭4バイトに画像サイズを出力
Put #FNo, , Binary '続けて画像のバイナリを出力
Put #FNo, , Text '最後にテキストを出力
Close #FNo
Erase Binary
End Sub
'--------------------------------------------------
Public Function LoadFromFile( _
ByVal FileName As String, _
Optional ByRef Text As Variant) As Picture
If Dir(FileName, vbReadOnly Or vbHidden Or vbSystem) = "" Then
Err.Raise 53, , "No File [" & FileName & "]"
End If
'データファイルを開く
Dim FNo As Integer
FNo = FreeFile(0)
Open FileName For Binary Access Read As #FNo
'データの読み込み
Dim ImageSize As Long
Get #FNo, , ImageSize '先頭4バイトから画像サイズを取得
If ImageSize > 0 Then
'画像バイナリを一時ファイルに保存
Dim Binary() As Byte
Dim WorkFileName As String
WorkFileName = FileName & ".~image"
ReDim Binary(ImageSize - 1)
Get #FNo, , Binary '画像のバイナリを取得
'一時ファイルからLoadPictureで読み込み
Dim WorkFileNo As Integer
WorkFileNo = FreeFile(1)
Open WorkFileName For Binary Access Write As #WorkFileNo
Put #WorkFileNo, , Binary
Close #WorkFileNo
Erase Binary
Set LoadFromFile = LoadPicture(WorkFileName)
Kill WorkFileName
End If
'最後に、テキストを取得
If Not EOF(FNo) Then
Get #FNo, , Text
End If
Close #FNo
End Function
'==================================================
# 久しぶりに VB4 を使ったら、いろいろと忘れてしまっていた事に愕然……。(^^;
## Optional 引数に String を使おうとしてしまったり ← VB4 では不可
## Optional 引数に 規定値 を割り当てようとしてしまったり ← VB4 では不可
## バイナリ読み込みに InputB を使ってしまったり ← VB4 の InputB は低速
こんにちは。
久しぶりに来てみたした。いろいろ失礼なことを言ったのに、すごい長いコードを教えてくださって、
魔界の仮面弁士さんありがとうございました。
お礼が遅くなりました。
とても参考になりました。本当にありがとうございました。
| ツイート |  |