| |
みなさんこんにちわ
私は、先日似たような質問をしていた者です。その節はneputuneさん、yuu1さん
ありがとうございました。
私の場合はフォーム上のImageだったのですが、自分の復習をかねてちょっと
やってみました。説明がおかしかったら適度につっこみをいれて下さい。
必要な物
新規ワークブックにImage1を配置し、ペイントか何かで白色のbmpファイル
を作成しておいて下さい。
方針
Imageそのもののハンドルではなく、Image1のPictureにロードした絵のハン
ドルを利用し(Image1.Picture.Handle),CreateCompatibleDCで互換性のある
hDCを作成しSelectObjectでhDCとハンドルを関連付けて使用する。
(最終的なデバイスコンテクストはhComDCです。)
neputuneさんに教えて頂いたやり方です。
標準モジュールに
'*****************************************************************
Option Explicit
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 Const MM_TWIPS = 6
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
Public Declare Function GetDC Lib "user32" _
(ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, ByVal hDC As Long) As Long
Public Declare Function MoveToEx Lib "gdi32" _
(ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, _
ByVal pLastPoint As Long) As Long
Public Declare Function LineTo Lib "gdi32" _
(ByVal hDC As Long, ByVal XEnd As Long, _
ByVal YEnd As Long) As Long
'*******************************************************************
Sub Get_Image_hDC()
Dim myImage As Image
Dim hBmp As Long, hDC As Long
Dim hComDC As Long
Dim ret As Long
Dim X As Long, Y As Long
Dim c As Integer, i As Integer
Set myImage = Worksheets("sheet1").Image1
myImage.Picture = Nothing
myImage.PictureAlignment = fmPictureAlignmentTopLeft
myImage.PictureSizeMode = fmPictureSizeModeStretch
'LineTo で引く直線の色がデフォルトで黒なので白のbmpをロードする。
myImage.Picture = LoadPicture(ThisWorkbook.Path & "\test.bmp")
hBmp = myImage.Picture.Handle
hDC = GetDC(0)
hComDC = CreateCompatibleDC(hDC)
ret = ReleaseDC(0, hDC)
ret = SetMapMode(hComDC, MM_TWIPS)
ret = SelectObject(hComDC, hBmp)
'////////////////////////////////////////////
'適当に棒グラフを描画
X = myImage.Picture.Width / 20
Y = myImage.Picture.Height / 20
MoveToEx hComDC, X, -Y * 9, 0
LineTo hComDC, X, -Y
MoveToEx hComDC, X, -Y * 9, 0
LineTo hComDC, X * 9, -Y * 9
For c = 2 To 7
Randomize
i = CInt(Rnd() * (7 - 1 + 1) + 1)
MoveToEx hComDC, X * c, -Y * 9, 0
LineTo hComDC, X * c, -Y * i
LineTo hComDC, X * (c + 1), -Y * i
LineTo hComDC, X * (c + 1), -Y * 9
Next
'////////////////////////////////////////////////
ret = DeleteDC(hComDC)
'書いたグラフを保存します。
SavePicture myImage.Picture, ThisWorkbook.Path & "\グラフ.bmp"
Set myImage = Nothing
End Sub
パス名の所は、ミカは記念日さんの環境にあわせて変えて下さい。
それでは、お互いがんばりましょう。
|
|
みそじのおじさん
- 08/6/14(土) 13:24 -
