Excel VBA質問箱 IV

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

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


25720 / 76732 ←次へ | 前へ→

【56350】Re:シート上Imageのデバイスコンテキストハンドル
発言  みそじのおじさん  - 08/6/14(土) 13:24 -

引用なし
パスワード
   みなさんこんにちわ

私は、先日似たような質問をしていた者です。その節は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


パス名の所は、ミカは記念日さんの環境にあわせて変えて下さい。
それでは、お互いがんばりましょう。

1 hits

【56149】シート上Imageのデバイスコンテキストハンドル ミカは記念 08/6/5(木) 11:18 質問
【56151】Re:シート上Imageのデバイスコンテキストハ... neptune 08/6/5(木) 15:45 発言
【56152】Re:シート上Imageのデバイスコンテキストハ... yuu1 08/6/5(木) 16:08 回答
【56350】Re:シート上Imageのデバイスコンテキストハ... みそじのおじさん 08/6/14(土) 13:24 発言

25720 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free