- ベストアンサー
SavePictureで保存できない
VB6での開発で ピクチャボックス(大)の中にピクチャボックス(小)を何個か入れ 全てのピクチャイメージを保存したいのですが「SavePicture ピクチャボックス(大), ファイル名」 を実行してもピクチャボックス(大)のみしか保存できません。 すべてのピクチャにAutoRedraw=Trueを設定しています。 どなたか分かる方がいらっしゃいましたら教えてください。 宜しくお願いします。
- みんなの回答 (6)
- 専門家の回答
質問者が選んだベストアンサー
ループの中の .Picture3.Picture = LoadPicture(wkAry(i)) に続いて .Picture3.Line (50, 50)-(2400, 150), , BF ですよね? 問題ないままに動いております。 こちらではエラーが出ておりません。 Command1_Clickイベントを張っておきます。 ----------------------------------------------------- Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long の宣言をした上で ----------------------------------------------------- Private Sub Command1_Click() Dim wkAry As Variant Dim i As Long Dim lngCntPic As Long '絵の情報 wkAry = Array( _ "C:\windows\しゃくなげ.bmp" _ , "C:\windows\グリーン ストーン.bmp" _ , "C:\windows\サポテック織り.bmp" _ , "C:\windows\サンタフェ.bmp" _ , "C:\windows\シャボン.bmp" _ ) 'ピクチャの数 lngCntPic = UBound(wkAry) + 1 'スクロールピクチャの高さ取得 lngScrollPicH = (lngCntPic + 1) * lngPicH With Me .Command1.Enabled = False .Command2.Enabled = True With .Picture1 .Visible = True End With With .Picture2 .Visible = True .Width = lngPicW .Height = lngScrollPicH .Left = 0 .Top = lngPicH - lngScrollPicH End With For i = 0 To lngCntPic - 1 .Picture3.Picture = LoadPicture(wkAry(i)) .Picture3.Line (50, 50)-(2400, 150), , BF 'イメージを取得したいので、ペイントピクチャは使用しない 'Call .Picture2.PaintPicture(.Picture3.Picture, 0, (lngCntPic - i) * lngPicH, lngPicW, lngPicH, 0, 0, .Picture3.ScaleWidth, .Picture3.ScaleHeight, vbSrcCopy) 'イメージを取得したいので、ストレッチぶりっとを使用する Call StretchBlt(.Picture2.hdc, 0, (lngCntPic - i) * lngPicH, lngPicW, lngPicH, Picture3.hdc, 0, 0, .Picture3.ScaleWidth, .Picture3.ScaleHeight, vbSrcCopy) If i = 0 Then 'Call .Picture2.PaintPicture(.Picture3.Picture, 0, 0, lngPicW, lngPicH, 0, 0, .Picture3.ScaleWidth, .Picture3.ScaleHeight, vbSrcCopy) Call StretchBlt(.Picture2.hdc, 0, 0, lngPicW, lngPicH, Picture3.hdc, 0, 0, .Picture3.ScaleWidth, .Picture3.ScaleHeight, vbSrcCopy) End If Next i End With End Sub
その他の回答 (5)
- 1050 円(@1050YEN)
- ベストアンサー率69% (477/687)
>'.Picture3.Picture = LoadPicture(wkAry(i)) >上記文はコメント(')にしています。 であればなおの事、#5のStretchBltを利用したサンプルでできませんか?
補足
週末にやってみたのですが やはりできませんでした。 もう少し時間をかけてやってみます。 また連絡します。
- 1050 円(@1050YEN)
- ベストアンサー率69% (477/687)
文章だけでは、どのようにやって、なぜ実現できていないかがわかりません。 コードの抜粋を公開してみてください。
補足
先ほど教えていただいたサンプルソース http://okweb.jp/kotaeru.php3?q=167464の この一行を変えただけです。 '.Picture3.Picture = LoadPicture(wkAry(i)) .Picture3.Line (50, 50)-(2400, 150), , BF 「ピクチャが不正です」とエラーが発生します。
- 1050 円(@1050YEN)
- ベストアンサー率69% (477/687)
すいません。 #1の後者の方では実験していませんが、前者の方で、保存できちゃいましたよー 私はWinXPなので、初期設定のビットマップ群のパスを C:\Winnt⇒C:\Windows に変更して、コマンドボタン3を追加し、 SavePicture Picture2.Image, "c:\aaa.bmp" としただけです。 後者の流用でできないのは、AutoRedrawのプロパティが違うのでは?
お礼
回答ありがとうございました。 ピクチャ2(子)に画像を取り込むとうまくいきましたが ピクチャ2(子)にLineで線を描きそれを ピクチャ1(親)にペイントしようとするとエラーで 戻ってきます。 ピクチャ2(子)の属性(?)をピクチャ1(親)に渡すにはやはり別の方法でないとだめなのでしょうか?
- 1050 円(@1050YEN)
- ベストアンサー率69% (477/687)
すんません。 日中はVB6がない場所に来ているので、実例でのアドバイスは困難ですー ExcelVBAではPictureBoxが無いので、擬似的に答えることもできませんですー 帰宅後にサンプルをアップしますねー
- 1050 円(@1050YEN)
- ベストアンサー率69% (477/687)
Picture親の中に Picture子1 Picture子2 ・・・ Picture子n があり、Picture親.SvaePictureで子のピクチャを含めて保存したいということですよね? Picture親の中の子達は、親のサイズ内に全て表示されていますか? ※親の枠をはみ出た位置に配置された子が存在しているのであれば、親に直接描画するしかないと思います。 http://okweb.jp/kotaeru.php3?q=167464 のようにPicture2のサイズを広げ、複数の画像をPicture2に転送して保存する方法が考えられます。 ※親の枠をはみ出た位置に配置された子が存在していないのであれば、そのPicure親のイメージを、他のピクチャボックスに転送して、保存したらいいと思います。 http://www.geocities.jp/h_sakusaku/ の「VBサンプル」の「8.画面のスナップ」
補足
>Picture親の中に >Picture子1 >Picture子2 >・・・ >Picture子n >があり、Picture親.SvaePictureで子のピクチャを含め>て保存したいということですよね? そうです。 Picture親の中の子達は、親のサイズ内に全て表示されています。 後者のサンプルを使ってやったのですが 出来ませんでした。(泣) 新たにピクチャボックス(Picture親2)を用意し StretchBlt()APIを使って Picture親の内容をPicture親2にコピーし SavePicture .Picture親2.Image, strSaveFileName で保存してみたのですが やっぱりPicture子nがコピーされずにPicture親の画像のみが保存されました。 どこが悪いのでしょうか?
補足
何度も回答ありがとうございますm(__)m '.Picture3.Picture = LoadPicture(wkAry(i)) 上記文はコメント(')にしています。