Excel VBA質問箱 IV

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

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


27645 / 76732 ←次へ | 前へ→

【54404】Re:Formに描画(API LineTo など)した絵をBitMapで保存できますか?
発言  neptune  - 08/3/11(火) 21:23 -

引用なし
パスワード
   ▼みそじのおじさん さん、VBWASURETA さん:
こんにちは

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

で、お詫びにちょっとサンプル書きました。
みそじのおじさん さんのサンプルに以下を追加するだけでとりあえず動きます。
十分検討してない(開放など)ので不安ですが、とりあえずと言う事でお願いします。
準備
1.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
    '以下は適当に環境に合わせて下さい。準備1で準備した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

'適当に1本の線を引くだけです。
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 質問
【54394】Re:Formに描画(API LineTo など)した絵を... みそじのおじさん 08/3/11(火) 15:42 質問
【54395】Re:Formに描画(API LineTo など)した絵を... VBWASURETA 08/3/11(火) 16:15 回答
【54396】Re:Formに描画(API LineTo など)した絵を... neptune 08/3/11(火) 16:19 発言
【54398】Re:Formに描画(API LineTo など)した絵を... みそじのおじさん 08/3/11(火) 17:38 質問
【54399】Re:Formに描画(API LineTo など)した絵を... VBWASURETA 08/3/11(火) 17:45 発言
【54401】Re:Formに描画(API LineTo など)した絵を... みそじのおじさん 08/3/11(火) 18:49 質問
【54403】Re:Formに描画(API LineTo など)した絵を... VBWASURETA 08/3/11(火) 20:58 発言
【54408】Re:Formに描画(API LineTo など)した絵を... VBWASURETA 08/3/12(水) 2:49 発言
【54435】Re:Formに描画(API LineTo など)した絵を... みそじのおじさん 08/3/12(水) 19:32 質問
【54437】Re:Formに描画(API LineTo など)した絵を... VBWASURETA 08/3/12(水) 23:04 発言
【54438】Re:Formに描画(API LineTo など)した絵を... neptune 08/3/12(水) 23:21 発言
【54439】Re:Formに描画(API LineTo など)した絵を... neptune 08/3/12(水) 23:23 発言
【54451】Re:Formに描画(API LineTo など)した絵を... みそじのおじさん 08/3/13(木) 16:08 発言
【54454】Re:Formに描画(API LineTo など)した絵を... VBWASURETA 08/3/13(木) 17:52 発言
【54461】Re:Formに描画(API LineTo など)した絵を... みそじのおじさん 08/3/13(木) 22:30 発言
【54462】Re:Formに描画(API LineTo など)した絵を... VBWASURETA 08/3/14(金) 0:34 発言
【54463】Re:Formに描画(API LineTo など)した絵を... VBWASURETA 08/3/14(金) 1:19 発言
【54452】Re:Formに描画(API LineTo など)した絵を... neptune 08/3/13(木) 16:20 発言
【54404】Re:Formに描画(API LineTo など)した絵を... neptune 08/3/11(火) 21:23 発言
【54450】Re:Formに描画(API LineTo など)した絵を... yuu1 08/3/13(木) 15:56 回答
【54464】Re:Formに描画(API LineTo など)した絵を... VBWASURETA 08/3/14(金) 9:15 発言
【54548】Re:Formに描画(API LineTo など)した絵を... みそじのおじさん 08/3/18(火) 11:32 お礼
【54550】Re:Formに描画(API LineTo など)した絵を... yuu1 08/3/18(火) 12:55 回答
【54551】Re:Formに描画(API LineTo など)した絵を... neptune 08/3/18(火) 14:55 発言
【54552】Re:Formに描画(API LineTo など)した絵を... VBWASURETA 08/3/18(火) 15:53 発言
【54559】Re:Formに描画(API LineTo など)した絵を... みそじのおじさん 08/3/19(水) 10:59 お礼
【54560】Re:Formに描画(API LineTo など)した絵を... neptune 08/3/19(水) 13:03 発言

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