Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

27650 / 76737

←次へ　｜　前へ→


	【54404】Re:Formに描画(API LineTo など）した絵をBitMapで保存できますか？

neptune - 08/3/11(火) 21:23 -


	引用なし

	パスワード

▼みそじのおじさんさん、VBWASURETA さん：
こんにちは

ごめんなさい。うそ書いてました。
Image1.Picture.Handle
はHBITMAPの間違いでした。

で、お詫びにちょっとサンプル書きました。
みそじのおじさんさんのサンプルに以下を追加するだけでとりあえず動きます。
十分検討してない（開放など）ので不安ですが、とりあえずと言う事でお願いします。
準備
１．paint等で、適当に白（何でも良い）のbmpﾌｧｲﾙを作成しておく

'//////////////////標準モジュール/////////////////
'////////////以下追加分/////////////
Public Const MM_TWIPS = 6
Public Declare Function CreateCompatibleDC Lib "gdi32" _
　　　　　　(ByVal hdc As Long) As Long
Public Declare Function SetMapMode Lib "gdi32" _
　　　　　　(ByVal hdc As Long, ByVal nMapMode As Long) As Long
Public Declare Function SelectObject Lib "gdi32" _
　　　　　　(ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" _
　　　　　　(ByVal hdc As Long) As Long

'///////////////UserForm1追加分//////////////////
Private Sub UserForm_Resize()
　　Const Fm_PictureSizeModeStretch As Long = 1

　　Me.Controls.Add "Forms.Image.1", "image1", False
　　With Me.Controls("image1")
　　　　.Top = Me.Top
　　　　.Left = Me.Left
　　　　.Height = Me.InsideHeight
　　　　.Width = Me.InsideWidth
　　　　'以下は適当に環境に合わせて下さい。準備１で準備したbmpファイルのフルパス
　　　　.Picture = LoadPicture("E:\Data\Office\Excel\WhiteBMP.bmp")
　　　　.PictureSizeMode = Fm_PictureSizeModeStretch
'　　　　.AutoSize = True
　　　　.Visible = True
　　End With
　　Me.Repaint
End Sub

'//////////////UserForm2////////////////////////////////////////
'CommandButton1_Clickは変更して下さい。
Private Sub CommandButton1_Click()
　　Call DrawLines
End Sub

'適当に１本の線を引くだけです。
Private Sub DrawLines()
Dim centerX As Long, centerY As Long
Dim hBmp As Long, hdc As Long
Dim hComDC As Long
Dim ret As Long
Dim i As Long
Dim img As MSForms.Image

　　Set img = UserForm1.Controls.Item("image1")
　　hBmp = img.Picture.Handle
　　hdc = GetDC(0)
　　hComDC = CreateCompatibleDC(hdc)
　　ret = ReleaseDC(0, hdc)
　　
　　ret = SetMapMode(hComDC, MM_TWIPS)
　　ret = SelectObject(hComDC, hBmp)
　
　　MoveToEx hComDC, 0, 0, 0
　　ret = LineTo(hComDC, img.Width * 10, img.Height * -10)

　　ret = DeleteDC(hComDC)
　　UserForm1.Repaint
　　Set img = Nothing

End Sub
>（うすい頭がさらにうすくなりそうです....)
私はもっと年上ですが、もう乗り越えたようです。
かなり薄くなってますが^ ^;

ファイルへの保存は不精してますが、savepaictureでやってみて下さい。

0 hits

▼

【54392】Formに描画(API LineTo など）した絵をBitMapで保存できますか？ みそじのおじさん 08/3/11(火) 14:51